SDEC781P ;ALB/DR/MGD - SD*5.3*781 Post Init routine ; Mar 29, 2021@19:00
;;5.3;SCHEDULING;**781**;AUG 13, 1993;Build 11
;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
W !!?3,"Updating SDEC SETTINGS file (#409.98)",!!
S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
D VERSION ;update GUI version number and date
D ENTER ; Original 778 Functionality
D SRD ; Original 781 Functionality
D POST ; Original 781 Functionality
D EXIT ; Combined 778 & 781 Functionality
Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.5
S DA=SDECDA,DIE=409.98,DR="2///1.7.5;3///"_DT D ^DIE ;update VS GUI NATIONAL
K DIE,DR,DA
S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)="" ;get DA for the VS GUI LOCAL
S DA=SDECDA1,DIE=409.98,DR="2///1.7.5;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
W !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
Q
;
; Original 778 functionality
;
; SDEC CONTACT (#409.86) file "B" indexed by PATIENT (#.01)
ENTER ;
S (DFN,CC,PDT,CLN,SER,REQT,PID)=""
S DFN="" F S DFN=$O(^SDEC(409.86,"B",DFN)) Q:DFN="" D
.S CC="" F S CC=$O(^SDEC(409.86,"B",DFN,CC)) Q:CC="" D
..S REC="" S REC=^SDEC(409.86,CC,0)
..S PDT=$P($G(REC),"^",3)
..I PDT[".24" D
...S X1=PDT,X2=1 D C^%DTC S PDT=X
...S PID=$P(PDT,".")
...S $P(^SDEC(409.86,CC,0),"^",3)=PID ; PREFERRED DATE
..S CLN=$P($G(REC),"^",2) ; CLINIC
..S SER=$P($G(REC),"^",6) ; SERVICE
..S REQT=$P($G(REC),"^",4) ; REQUEST TYPE
..I REQT="A"!(REQT="RTC") D AR40985 Q
..I REQT="C"!(REQT="P") D CONSULT Q
..I REQT="R" D RECALL Q
Q
;
; SDEC APPT REQUEST (#409.85) "B" indexed by PATIENT (#.01)
;^SDEC(409.85,"B",23,143611)=""
; 143612)=""
; 143987)=""
AR40985 ;
S (CCC,TYPE)=""
F S CCC=$O(^SDEC(409.85,"B",DFN,CCC)) Q:CCC="" D
.S REC1="" S REC1=^SDEC(409.85,CCC,0)
.S TYPE=$P(REC1,"^",5)
.Q:TYPE'="APPT"&(TYPE'="RTC")
.Q:$P(REC1,"^",16)'=$E(PDT,1,7)
.Q:CLN'=""&($P(REC1,"^",9)'=CLN)
.Q:SER'=""&($P(REC1,"^",6)'=SER)
.S $P(^SDEC(409.86,CC,0),"^",7)=CCC_";"_"SDEC(409.85,"
Q
;
CONSULT ;
S (IEN,PAT)=""
S PAT=DFN
F S IEN=$O(^GMR(123,"F",PAT,IEN)) Q:IEN="" D
.Q:$P(^GMR(123,IEN,0),U,2)'=DFN
.Q:$P(^GMR(123,IEN,0),U,17)'=REQT
.S $P(^SDEC(409.86,CC,0),"^",7)=IEN_";"_"GMR(123,"
Q
;
RECALL ;
S (IEN,PAT)=""
S PAT=DFN
F S IEN=$O(^SD(403.5,"B",PAT,IEN)) Q:IEN="" D
.Q:$P(^SD(403.5,IEN,0),U,1)'=DFN
.Q:$P(^SD(403.5,IEN,0),U,2)'=CLN
.Q:REQT'="R"
.S $P(^SDEC(409.86,CC,0),"^",7)=IEN_";"_"SD(403.5,"
Q
;
; Original 781 functionality
;
SRD ; Populate SRD x-ref for all existing entries
N DIK
S DIK="^SDEC(409.86,"
S DIK(1)="2.3^SRD"
D ENALL^DIK
Q
POST ; REPAIR INACTIVATE/REACTIVATE DATES IN FILE 44 AND 409.83
N SDFDA,SDIEN,SDIENS,CLINSDIEN,HINACDATE,HREACDATE,CLINSDIENS,RINACDATE,RREACDATE
S SDIEN=0
F S SDIEN=$O(^SC(SDIEN)) Q:'SDIEN D
.S SDIENS=SDIEN_","
.S CLINSDIENS=$$GETRES^SDECUTL(SDIEN,1)
.Q:CLINSDIENS=""
.Q:$$GET1^DIQ(409.831,CLINSDIENS_",",.012)'="CLINIC"
.S HINACDATE=$$GET1^DIQ(44,SDIENS,2505,"I")
.S HREACDATE=$$GET1^DIQ(44,SDIENS,2506,"I")
.S RINACDATE=$$GET1^DIQ(409.831,CLINSDIENS_",",.021,"I")
.S RREACDATE=$$GET1^DIQ(409.831,CLINSDIENS_",",.025,"I")
.I RINACDATE'=HINACDATE D
..S SDFDA(409.831,CLINSDIENS_",",.021)=HINACDATE,SDFDA(409.831,CLINSDIENS_",",.022)=.5
..I HINACDATE="",RINACDATE'="" D
...S SDFDA(409.831,CLINSDIENS_",",.021)="@"
...S SDFDA(409.831,CLINSDIENS_",",.022)="@"
.I RREACDATE'=HREACDATE D
..S SDFDA(409.831,CLINSDIENS_",",.025)=HREACDATE,SDFDA(409.831,CLINSDIENS_",",.026)=.5
..I HREACDATE="",RREACDATE'="" D
...S SDFDA(409.831,CLINSDIENS_",",.025)="@"
...S SDFDA(409.831,CLINSDIENS_",",.026)="@"
.I $D(SDFDA) D FILE^DIE(,"SDFDA","ERR") K SDFDA
Q
;
EXIT ;
W !,"POST-INIT Routine Complete!"
K CC,CCC,CLN,DFN,PAT,PDT,REC,REC1,REQT,IEN,PAT,TYPE,SER,PID,X,X1,X2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC781P 4076 printed Apr 09, 2024@21:50:25 Page 2
SDEC781P ;ALB/DR/MGD - SD*5.3*781 Post Init routine ; Mar 29, 2021@19:00
+1 ;;5.3;SCHEDULING;**781**;AUG 13, 1993;Build 11
+2 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 WRITE !!?3,"Updating SDEC SETTINGS file (#409.98)",!!
+3 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+4 ;update GUI version number and date
DO VERSION
+5 ; Original 778 Functionality
DO ENTER
+6 ; Original 781 Functionality
DO SRD
+7 ; Original 781 Functionality
DO POST
+8 ; Combined 778 & 781 Functionality
DO EXIT
+9 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.5
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.5;3///"_DT
DO ^DIE
+2 KILL DIE,DR,DA
+3 ;get DA for the VS GUI LOCAL
SET SDECDA1=0
SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
if $GET(SDECDA1)=""
QUIT
+4 ;update VS GUI LOCAL
SET DA=SDECDA1
SET DIE=409.98
SET DR="2///1.7.5;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
+1 WRITE !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
+2 QUIT
+3 ;
+4 ; Original 778 functionality
+5 ;
+6 ; SDEC CONTACT (#409.86) file "B" indexed by PATIENT (#.01)
ENTER ;
+1 SET (DFN,CC,PDT,CLN,SER,REQT,PID)=""
+2 SET DFN=""
FOR
SET DFN=$ORDER(^SDEC(409.86,"B",DFN))
if DFN=""
QUIT
Begin DoDot:1
+3 SET CC=""
FOR
SET CC=$ORDER(^SDEC(409.86,"B",DFN,CC))
if CC=""
QUIT
Begin DoDot:2
+4 SET REC=""
SET REC=^SDEC(409.86,CC,0)
+5 SET PDT=$PIECE($GET(REC),"^",3)
+6 IF PDT[".24"
Begin DoDot:3
+7 SET X1=PDT
SET X2=1
DO C^%DTC
SET PDT=X
+8 SET PID=$PIECE(PDT,".")
+9 ; PREFERRED DATE
SET $PIECE(^SDEC(409.86,CC,0),"^",3)=PID
End DoDot:3
+10 ; CLINIC
SET CLN=$PIECE($GET(REC),"^",2)
+11 ; SERVICE
SET SER=$PIECE($GET(REC),"^",6)
+12 ; REQUEST TYPE
SET REQT=$PIECE($GET(REC),"^",4)
+13 IF REQT="A"!(REQT="RTC")
DO AR40985
QUIT
+14 IF REQT="C"!(REQT="P")
DO CONSULT
QUIT
+15 IF REQT="R"
DO RECALL
QUIT
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ; SDEC APPT REQUEST (#409.85) "B" indexed by PATIENT (#.01)
+19 ;^SDEC(409.85,"B",23,143611)=""
+20 ; 143612)=""
+21 ; 143987)=""
AR40985 ;
+1 SET (CCC,TYPE)=""
+2 FOR
SET CCC=$ORDER(^SDEC(409.85,"B",DFN,CCC))
if CCC=""
QUIT
Begin DoDot:1
+3 SET REC1=""
SET REC1=^SDEC(409.85,CCC,0)
+4 SET TYPE=$PIECE(REC1,"^",5)
+5 if TYPE'="APPT"&(TYPE'="RTC")
QUIT
+6 if $PIECE(REC1,"^",16)'=$EXTRACT(PDT,1,7)
QUIT
+7 if CLN'=""&($PIECE(REC1,"^",9)'=CLN)
QUIT
+8 if SER'=""&($PIECE(REC1,"^",6)'=SER)
QUIT
+9 SET $PIECE(^SDEC(409.86,CC,0),"^",7)=CCC_";"_"SDEC(409.85,"
End DoDot:1
+10 QUIT
+11 ;
CONSULT ;
+1 SET (IEN,PAT)=""
+2 SET PAT=DFN
+3 FOR
SET IEN=$ORDER(^GMR(123,"F",PAT,IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 if $PIECE(^GMR(123,IEN,0),U,2)'=DFN
QUIT
+5 if $PIECE(^GMR(123,IEN,0),U,17)'=REQT
QUIT
+6 SET $PIECE(^SDEC(409.86,CC,0),"^",7)=IEN_";"_"GMR(123,"
End DoDot:1
+7 QUIT
+8 ;
RECALL ;
+1 SET (IEN,PAT)=""
+2 SET PAT=DFN
+3 FOR
SET IEN=$ORDER(^SD(403.5,"B",PAT,IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 if $PIECE(^SD(403.5,IEN,0),U,1)'=DFN
QUIT
+5 if $PIECE(^SD(403.5,IEN,0),U,2)'=CLN
QUIT
+6 if REQT'="R"
QUIT
+7 SET $PIECE(^SDEC(409.86,CC,0),"^",7)=IEN_";"_"SD(403.5,"
End DoDot:1
+8 QUIT
+9 ;
+10 ; Original 781 functionality
+11 ;
SRD ; Populate SRD x-ref for all existing entries
+1 NEW DIK
+2 SET DIK="^SDEC(409.86,"
+3 SET DIK(1)="2.3^SRD"
+4 DO ENALL^DIK
+5 QUIT
POST ; REPAIR INACTIVATE/REACTIVATE DATES IN FILE 44 AND 409.83
+1 NEW SDFDA,SDIEN,SDIENS,CLINSDIEN,HINACDATE,HREACDATE,CLINSDIENS,RINACDATE,RREACDATE
+2 SET SDIEN=0
+3 FOR
SET SDIEN=$ORDER(^SC(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+4 SET SDIENS=SDIEN_","
+5 SET CLINSDIENS=$$GETRES^SDECUTL(SDIEN,1)
+6 if CLINSDIENS=""
QUIT
+7 if $$GET1^DIQ(409.831,CLINSDIENS_",",.012)'="CLINIC"
QUIT
+8 SET HINACDATE=$$GET1^DIQ(44,SDIENS,2505,"I")
+9 SET HREACDATE=$$GET1^DIQ(44,SDIENS,2506,"I")
+10 SET RINACDATE=$$GET1^DIQ(409.831,CLINSDIENS_",",.021,"I")
+11 SET RREACDATE=$$GET1^DIQ(409.831,CLINSDIENS_",",.025,"I")
+12 IF RINACDATE'=HINACDATE
Begin DoDot:2
+13 SET SDFDA(409.831,CLINSDIENS_",",.021)=HINACDATE
SET SDFDA(409.831,CLINSDIENS_",",.022)=.5
+14 IF HINACDATE=""
IF RINACDATE'=""
Begin DoDot:3
+15 SET SDFDA(409.831,CLINSDIENS_",",.021)="@"
+16 SET SDFDA(409.831,CLINSDIENS_",",.022)="@"
End DoDot:3
End DoDot:2
+17 IF RREACDATE'=HREACDATE
Begin DoDot:2
+18 SET SDFDA(409.831,CLINSDIENS_",",.025)=HREACDATE
SET SDFDA(409.831,CLINSDIENS_",",.026)=.5
+19 IF HREACDATE=""
IF RREACDATE'=""
Begin DoDot:3
+20 SET SDFDA(409.831,CLINSDIENS_",",.025)="@"
+21 SET SDFDA(409.831,CLINSDIENS_",",.026)="@"
End DoDot:3
End DoDot:2
+22 IF $DATA(SDFDA)
DO FILE^DIE(,"SDFDA","ERR")
KILL SDFDA
End DoDot:1
+23 QUIT
+24 ;
EXIT ;
+1 WRITE !,"POST-INIT Routine Complete!"
+2 KILL CC,CCC,CLN,DFN,PAT,PDT,REC,REC1,REQT,IEN,PAT,TYPE,SER,PID,X,X1,X2
+3 QUIT
