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