182 lines
6.7 KiB
Mathematica
182 lines
6.7 KiB
Mathematica
SCMSP ;ALB/MTC - POST INIT ROUTINE;28-MAY-1996
|
|
;;5.3;Scheduling;**44**;AUG 13, 1993
|
|
;
|
|
HOPUP ;-- This function will update all the clinics in file #44 to
|
|
; require Provider and Diagnosis for checkout. Using the "B"
|
|
; x-ref a check will be performed to make sure that the location
|
|
; is clinic then fields 26 (Ask provider@ CO) and 27 (Ask diagnosis
|
|
; @ CO) will be set to 1 (REQUIRED).
|
|
;
|
|
N SCX,SCY,SCZ,DIC,DIE,DA,DR,X,Y,%,%H,%I
|
|
N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ
|
|
;
|
|
S SCX=0
|
|
F S SCX=$O(^SC("B",SCX)) Q:SCX="" S SCY=0 F S SCY=$O(^SC("B",SCX,SCY)) Q:'SCY D
|
|
. S SCZ=$G(^SC(SCY,0)) Q:SCZ=""
|
|
. I $P(SCZ,U,3)'="C" Q
|
|
. I $$OCCA^SCDXUTL(SCY) Q
|
|
. S DIE="^SC(",DA=SCY,DR="26///1;27///1" D ^DIE
|
|
;Get current date/time
|
|
D NOW^%DTC
|
|
;Convert to external format
|
|
S SCZ=$P(%,".",2)_"000000"
|
|
S SCY=$E(SCZ,1,2)_":"_$E(SCZ,3,4)_":"_$E(SCZ,5,6)
|
|
S SCX=%I(1)_"/"_%I(2)_"/"_(%I(3)+1700)_" @ "_SCY
|
|
;Store completion time in Scheduling Parameter file
|
|
S SCZ=0
|
|
F X=1:1:10 L +^SD(404.91,1,"AMB"):5 I ($T) S SCZ=1 Q
|
|
S:(SCZ) $P(^SD(404.91,1,"AMB"),"^",7)=%
|
|
L -^SD(404.91,1,"AMB")
|
|
;Send completion bulletin
|
|
;Set message text
|
|
S MSGTXT(1)=" "
|
|
S MSGTXT(2)="Updating of all clinics contained in the HOSPITAL LOCATION"
|
|
S MSGTXT(3)="file (#44) to require provider and diagnosis for checkout"
|
|
S MSGTXT(4)="completed on "_SCX
|
|
S MSGTXT(5)=" "
|
|
;Set bulletin subject
|
|
S XMB(1)="HOSPITAL LOCATION UPDATE COMPLETED"
|
|
;Deliver bulletin
|
|
S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
|
|
S XMTEXT="MSGTXT("
|
|
D ^XMB
|
|
Q
|
|
;
|
|
PARAM ;ALB/JLU - This entry point will set the Amb Care parameters in the
|
|
; Scheduling parameter file
|
|
;
|
|
N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,DELAY
|
|
N PTRPAR,DLAYGO,DINUM,NODE,TASKNUM,QUEUEDT
|
|
D BMES^XPDUTL(">>> Setting parameters contained in SCHEDULING PARAMETER file (#404.91)")
|
|
;Create/find entry
|
|
S DIC="^SD(404.91,"
|
|
S DIC(0)="LX"
|
|
S DIC("DR")=".001///1"
|
|
S DLAYGO=404.91
|
|
S DINUM=1
|
|
S X=1
|
|
D ^DIC
|
|
S PTRPAR=+Y
|
|
;Unable to create/find entry - quit
|
|
I (Y<0) D Q
|
|
.S MSGTXT(1)=" *** Unable to create/find entry in Scheduling Parameter file"
|
|
.S MSGTXT(2)=" *** Unable to store parameters relating to Ambulatory Care"
|
|
.D MES^XPDUTL(.MSGTXT)
|
|
;Get check point's parameter data. This value will be in the
|
|
; format QueueTime-TaskNumber
|
|
S X=$$PARCP^XPDUTL("SCMS01")
|
|
S QUEUEDT=$P(X,"-",1)
|
|
S TASKNUM=$P(X,"-",2)
|
|
;Store Ambulatory Care parameters - using hard set since there's no
|
|
; cross references on these fields
|
|
S NODE=$G(^SD(404.91,PTRPAR,"AMB"))
|
|
S $P(NODE,U,1)=+$P(NODE,U,1)
|
|
S $P(NODE,U,2)=2961001
|
|
S $P(NODE,U,3)=2961101
|
|
S DELAY=+$P(NODE,U,4)
|
|
S:('DELAY) DELAY=2
|
|
S $P(NODE,U,4)=DELAY
|
|
S $P(NODE,U,5)=QUEUEDT
|
|
S $P(NODE,U,6)=TASKNUM
|
|
S $P(NODE,U,7)="0000000"
|
|
S ^SD(404.91,1,"AMB")=NODE
|
|
D MES^XPDUTL(" Parameters relating to Ambulatory Care have been stored")
|
|
Q
|
|
;
|
|
MG4BULL ;ALB/JRP - Attach Mail Group that receives OPC generation bulletin
|
|
; to the Ambulatory Care transmission summary bulletin
|
|
;
|
|
;Input : None
|
|
;Output : None
|
|
;Notes : This is a KIDS complient check point
|
|
;
|
|
;Declare variables
|
|
N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,OPCMG,BULLNAME,PTRBULL,MSGTXT
|
|
D BMES^XPDUTL(">>> Attaching mail group to Ambulatory Care transmission summary bulletin")
|
|
;Get name of Mail Group that receives OPC generation bulletin
|
|
S OPCMG=$$OPCMG^SCMSPU1(1)
|
|
I (OPCMG="") D Q
|
|
.S MSGTXT(1)=" ** MAS PARAMETER file (#43) does not have a value for"
|
|
.S MSGTXT(2)=" the OPC GENERATE MAIL GROUP field (#216)"
|
|
.S MSGTXT(3)=" ** Unable to attach mail group to the SCDX AMBCARE"
|
|
.S MSGTXT(4)=" TO NPCDB SUMMARY bulletin"
|
|
.S MSGTXT(5)=" ** Mail group must be added to bulletin manually"
|
|
.D MES^XPDUTL(.MSGTXT)
|
|
;Get pointer to Ambulatory Care transmission summary bulletin
|
|
S BULLNAME="SCDX AMBCARE TO NPCDB SUMMARY"
|
|
S PTRBULL=+$O(^XMB(3.6,"B",BULLNAME,0))
|
|
I ('PTRBULL) D Q
|
|
.S MSGTXT(1)=" ** Unable to find entry for SCDX AMBCARE TO NPCDB"
|
|
.S MSGTXT(2)=" SUMMARY in BULLETIN file (#3.6)"
|
|
.S MSGTXT(3)=" ** Bulletin must be manually entered"
|
|
.D MES^XPDUTL(.MSGTXT)
|
|
;Attach Mail Group to Ambulatory Care transmission summary bulletin
|
|
S DIC="^XMB(3.6,"_PTRBULL_",2,"
|
|
S DIC(0)="LX"
|
|
S DIC("P")=$P(^DD(3.6,4,0),"^",2)
|
|
S DA(1)=PTRBULL
|
|
S DLAYGO=3.6
|
|
S X=OPCMG
|
|
D ^DIC
|
|
S MSGTXT(1)=" Mail group contained in the OPC GENERATE MAIL GROUP"
|
|
S MSGTXT(2)=" field (#216) of the MAS PARAMETER file (#43) has"
|
|
S MSGTXT(3)=" been attached to the SCDX AMBCARE TO NPCDB SUMMARY bulletin"
|
|
I (Y<0) D
|
|
.K MSGTXT
|
|
.S MSGTXT(1)=" ** Unable to attach mail group to the SCDX AMBCARE"
|
|
.S MSGTXT(2)=" TO NPCDB SUMMARY bulletin"
|
|
.S MSGTXT(3)=" ** Mail group must be added to bulletin manually"
|
|
D MES^XPDUTL(.MSGTXT)
|
|
;Done
|
|
Q
|
|
;
|
|
SDM ;ALB/JRP - Have an overlap routine with PCMM (SD*5.3*41)
|
|
; Make sure that correct version of SDM routine is installed
|
|
;
|
|
;Input : None
|
|
;Output : None
|
|
;Notes : This is a KIDS complient check point
|
|
; : Routine SCMSPX1 contains SDM with patch 41 applied to it
|
|
; and routine SCMSPX2 contains SDM with patch 41 not applied
|
|
; to it
|
|
;
|
|
;Declare variables
|
|
N PATCHED,TMP,MSGTXT
|
|
D BMES^XPDUTL(">>> Installing correct version of routine SDM")
|
|
;Check for PCMM installation
|
|
S PATCHED=$$PATCH^XPDUTL("SD*5.3*41")
|
|
;PCMM not installed - SDM should come from SCMSPX2
|
|
I ('PATCHED) D
|
|
.S MSGTXT(1)=" "
|
|
.S MSGTXT(2)=" PCMM has NOT been installed. Will install a version"
|
|
.S MSGTXT(3)=" of routine SDM that DOES NOT have the PCMM changes"
|
|
.S MSGTXT(4)=" applied to it."
|
|
.S MSGTXT(5)=" "
|
|
.S MSGTXT(6)=" MSM sites must copy the SDM routine to all appropriate UCIs"
|
|
.S MSGTXT(7)=" "
|
|
.S MSGTXT(8)=" ********** PLEASE NOTE THE FOLLOWING ***********"
|
|
.S MSGTXT(9)=" * *"
|
|
.S MSGTXT(10)=" * After installing PCMM, call the routine *"
|
|
.S MSGTXT(11)=" * SCMSP at theline tag SDM (i.e. D SDM^SCMSP) *"
|
|
.S MSGTXT(12)=" * in order to install a version of routine SDM *"
|
|
.S MSGTXT(13)=" * with the ACRP & PCMM changes applied to it. *"
|
|
.S MSGTXT(14)=" * *"
|
|
.S MSGTXT(15)=" * MSM sites will then need to copy the updated *"
|
|
.S MSGTXT(16)=" * SDM routine to all appropriate UCIs. *"
|
|
.S MSGTXT(17)=" * *"
|
|
.S MSGTXT(18)=" ************************************************"
|
|
.D MES^XPDUTL(.MSGTXT)
|
|
.S TMP=$$COPY^SCMSPU2("SCMSPX2","SDM",3)
|
|
;PCMM installed - SDM should come from SCMSPX1
|
|
I (PATCHED) D
|
|
.S MSGTXT(1)=" "
|
|
.S MSGTXT(2)=" PCMM has been installed. Will install a version"
|
|
.S MSGTXT(3)=" of routine SDM that has the PCMM changes applied"
|
|
.S MSGTXT(4)=" to it"
|
|
.S MSGTXT(5)=" "
|
|
.S MSGTXT(6)=" MSM sites must copy the SDM routine to all appropriate UCIs"
|
|
.D MES^XPDUTL(.MSGTXT)
|
|
.S TMP=$$COPY^SCMSPU2("SCMSPX1","SDM",3)
|
|
;Done
|
|
Q
|