EC2P5PST ;ALB/GTS - PATCH EC*2.0*5 Post-Init Rtn ; 8/13/97
;;2.0; EVENT CAPTURE ;**5**;8 May 96
;
;NOTE: This routine is full if it must be broken to 2nd rtn,
; DUPCHK and SCCHK are the tags to pull into EC2P5P1
;
TEXT ; Install desc.
;; This part of the install walks through the DSS file to check
;; for the existence of an Associated DSS ID (Associated Stop Code).
;; Those DSS Units not sending data to PCE must have an Associated
;; DSS ID. If the DSS Units Associated DSS IDs, they are converted
;; to pointers to the Clinic Stop file (#40.7). DSS Units not having
;; Associated DSS IDs or having inactive DSS IDs are noted in a message
;; sent to the installer. The installer should forward the message
;; to Medical Center personnel responsible for administration of
;; Event Capture DSS Units.
;;
;;QUIT
;
MSGINTR ; Mail message intro
;; Installation of EC*2*5 walks through the DSS Unit file to check
;; the existence of an Associated DSS ID (Associated Stop Code).
;; DSS Units not sending data to PCE must have an Associated DSS
;; ID. If the DSS Units have Associated DSS IDs, they are converted
;; to pointers to the Clinic Stop file (#40.7). Those DSS Units
;; NOT having Associated DSS IDs or having inactive DSS IDs are noted
;; in this message. Medical Center personnel responsible for
;; administration of Event Capture DSS Units should note the items
;; in this message indicating '**USER EDIT IS REQUIRED**'. Those
;; items indicating 'User REVIEW suggested' denote DSS IDs which
;; have been inactivated. The Event Capture option, DSS Units for
;; Event Capture (Enter/Edit), will allow the user to correct the
;; Associated DSS ID problems identified in this message.
;;QUIT
;
POST ; Set Checkpoint
N %
S %=$$NEWCP^XPDUTL("IEN","ENTPOST^EC2P5PST",0)
Q
;
ENTPOST ; Entry point
;
D CRESPEC^EC725P ;** File #725 mods
;
;* If X-refs for DBIA 1902 already added, do not reindex
I $$GET1^DID(721,"","","PACKAGE REVISION DATA")["EC*2*5" DO
.D MES^XPDUTL(" ")
.D MES^XPDUTL("EC Patient File #721, Visit field #28 previously reindexed.")
.D MES^XPDUTL(" ")
;
;* Reindex EC Patient file for DBIA 1902
I $$GET1^DID(721,"","","PACKAGE REVISION DATA")'["EC*2*5" D RNDEX^EC2P5P1
;
;* If 724 converted, write message
I $$GET1^DID(724,"","","PACKAGE REVISION DATA")["EC*2*5" DO
.D MES^XPDUTL(" ")
.D MES^XPDUTL("DSS Unit File #724 previously converted from DSS IDs to pointers")
.D MES^XPDUTL("to the Clinic Stop file (#40.7).")
.D MES^XPDUTL(" ")
;
;* Convert DSS Unit, DSS ID
I $$GET1^DID(724,"","","PACKAGE REVISION DATA")'["EC*2*5" D ENTCNV
Q
;
ENTCNV ; Convert DSS Unit, Associated DSS ID
N TXTVAR
D MES^XPDUTL(" "),MES^XPDUTL(" ")
F I=1:1 S TXTVAR=$P($T(TEXT+I),";;",2) Q:TXTVAR="QUIT" DO
.S:TXTVAR="" TXTVAR=" "
.D MES^XPDUTL(TXTVAR)
D START
D KVARS
Q
;
START ; Start proc
S COUNT=0
;
D MES^XPDUTL(" ")
D MES^XPDUTL("Inspecting Associated DSS IDs in the DSS Unit file.")
;
;** Inspect Associated DSS ID
N ECDUDA,ECPCE,ECDSSID,ECDSUNME,ECDNODE,MSGTXT,MSGTXT1,MSGTXT2,ECIDVAR
N DSSIDSTF
D LINE(" "),LINE(" ")
F I=1:1 S TXTVAR=$P($T(MSGINTR+I),";;",2) Q:TXTVAR="QUIT" DO
.S:TXTVAR="" TXTVAR=" "
.D LINE(TXTVAR)
S ECDUDA=+$$PARCP^XPDUTL("IEN")
F S ECDUDA=$O(^ECD(ECDUDA)) Q:+ECDUDA=0 DO
.I $D(^ECD(ECDUDA,0)) DO
..S ECDNODE=^ECD(ECDUDA,0)
..S ECPCE=$P(ECDNODE,"^",14)
..;* If Unit not sending to PCE
..I ECPCE=""!(ECPCE="N") D NOPCE
..I ECPCE'="",(ECPCE'="N") D SENDPCE
D PRD^DILFD(724,"EC*2*5") ;** Set VRRV node (file #724)
D MAIL
Q
;
KVARS K COUNT,Y,I
Q
;
NOPCE ; Process Units NOT sent to PCE
S ECDSSID=$P(ECDNODE,"^",10)
S ECDSUNME=$P(ECDNODE,"^",1)
;* If DSS ID is null
I ECDSSID="" DO
.S MSGTXT="There is no Associated DSS ID for the DSS Unit "_ECDSUNME
.D LINE(" ")
.D LINE(MSGTXT)
.D LINE("**USER EDIT IS REQUIRED**")
;* If DSS ID is not null
I ECDSSID'="" DO
.S ECIDVAR=$$SCCHK(+ECDSSID) ;* Check 40.7 for DSS ID
.I +ECIDVAR=-1,(+$P(ECIDVAR,"^",2)=0) DO ;* DSS ID does not exist
..S MSGTXT="Associated DSS ID for the DSS Unit "_ECDSUNME_" does not exist."
..D LINE(" ")
..D LINE(MSGTXT)
..D LINE("**USER EDIT IS REQUIRED**")
..D NULLID ;**Nullify BAD DSS ID data
.;* DSS ID is inactive
.I +ECIDVAR=-1,(+$P(ECIDVAR,"^",2)'=0) DO
..S Y=$P(ECIDVAR,"^",3)
..D DD^%DT
..S MSGTXT="Associated DSS ID for the DSS Unit "_ECDSUNME_" was inactivated"
..S MSGTXT1="effective "_Y_". User REVIEW suggested."
..D LINE(" ")
..D LINE(MSGTXT)
..D LINE(MSGTXT1)
..D CONVRT ;**Convert to pointer (40.7)
.;* DSS ID found and active
.I +ECIDVAR=1 DO
..I +$P(ECIDVAR,"^",3)>0 DO
...S Y=$P(ECIDVAR,"^",3)
...D DD^%DT
...S MSGTXT="Associated DSS ID for "_ECDSUNME_" was found and is active."
...S MSGTXT1=ECDSSID_" ("_$P(^DIC(40.7,$P(ECIDVAR,"^",2),0),"^",1)_") will become"
...S MSGTXT2="inactive on "_Y_", however. (User information only.)"
...D LINE(" ")
...D LINE(MSGTXT)
...D LINE(MSGTXT1)
...D LINE(MSGTXT2)
..D CONVRT ;**Convert to pointer (40.7)
.I +ECIDVAR=2 DO
..S MSGTXT="Associated DSS ID "_ECDSSID_" for the DSS Unit "_ECDSUNME
..S MSGTXT1="has multiple DSS ID Names. **USER EDIT IS REQUIRED**"
..D LINE(" ")
..D LINE(MSGTXT)
..D LINE(MSGTXT1)
..D NULLID ;**Nullify BAD DSS ID data
Q
;
SENDPCE ; Process units sent to PCE
S ECDSSID=$P(ECDNODE,"^",10)
S ECDSUNME=$P(ECDNODE,"^",1)
;* If DSS ID is not Null
I ECDSSID'="" DO
.S ECIDVAR=$$SCCHK(+ECDSSID) ;* Check 40.7 for DSS ID
.I +ECIDVAR'=1 DO
..S MSGTXT="Associated DSS ID for "_ECDSUNME_" was either not found, is inactive or has"
..S MSGTXT1="multiple active DSS ID names."
..S MSGTXT2=ECDSSID_" was removed from "_ECDSUNME_"."
..D LINE(" ")
..D LINE(MSGTXT)
..D LINE(MSGTXT1)
..D LINE(MSGTXT2)
..D LINE("User Information only. Events for this unit are not sent to PCE")
..D NULLID ;**Nullify BAD DSS ID data
.I +ECIDVAR=1 DO
..S MSGTXT="Associated DSS ID for "_ECDSUNME_" converted for "_ECDSSID_"."
..D LINE(" ")
..D LINE(MSGTXT)
..D LINE("User Information only. Events for this unit are not sent to PCE")
..D CONVRT ;**Convert to pointer (40.7)
Q
;
CONVRT ; Convert DSS ID to pointer
; Required variables (defined)
; ECIDVAR - Result of SCCHK
; ECDUDA - IEN of DSS Unit processing
; DSSIDSTF - Must be NEW'ed prior to calling
;
S DSSIDSTF=$P(ECIDVAR,"^",2)
S DIE="^ECD(",DA=ECDUDA,DR="9////^S X=DSSIDSTF"
D ^DIE
N %
S %=$$UPCP^XPDUTL("IEN",ECDUDA)
K DIE,DA,DR
Q
;
NULLID ; Nullify BAD DSS IDs
; Required variables (defined)
; ECDUDA - IEN of DSS Unit processing
;
S DIE="^ECD(",DA=ECDUDA,DR="9////@"
D ^DIE
N %
S %=$$UPCP^XPDUTL("IEN",ECDUDA)
K DIE,DA,DR
Q
;
SCCHK(ECDSSID) ; Check 40.7 for DSS ID
; Input:
; ECDSSID - The DSS ID to check
;
; Output:
; ECRESULT - Indicates if the DSS ID was found
; Values
; -1 : DSS ID was not found
; -1^ien^Inactivation date : DSS ID found but is inactive
; 1^ien^Inactivation date : DSS ID found and is active
; Pce 3=null if no inactv date
; 2 : Multiple active entries found
;
N ECRESULT,ECIDDA,CONTINUE,ECSCNODE,DUPRSLT
S CONTINUE=1
S ECRESULT=-1
I CONTINUE,($D(^DIC(40.7,"C",ECDSSID))) DO
.S ECIDDA=$O(^DIC(40.7,"C",ECDSSID,""))
.I CONTINUE,(+ECIDDA'>0) S CONTINUE=0 ;**DSS ID does not exist
.I CONTINUE,($D(^DIC(40.7,ECIDDA,0))) DO ;**DSS ID exists
..S ECSCNODE=^DIC(40.7,ECIDDA,0)
..S DUPRSLT=$$DUPCHK(ECDSSID,ECIDDA)
..I CONTINUE,($P(ECSCNODE,"^",3)'="") DO
...I CONTINUE,(DT>$P(ECSCNODE,"^",3)) DO ;**DSS ID inactive
....I +DUPRSLT<1 DO ;**Only one entry (inactive) for DSS ID
.....S ECRESULT="-1^"_ECIDDA_"^"_$P(ECSCNODE,"^",3)
....I +DUPRSLT=1 DO ;**An active DSS ID found
.....S ECRESULT="1^"_$P(DUPRSLT,"^",2)_"^"_$P(^DIC(40.7,$P(DUPRSLT,"^",2),0),"^",3)
....I +DUPRSLT=2 DO ;**Multiple active DSS IDs found
.....S ECRESULT=2
....S CONTINUE=0
..I CONTINUE,($P(ECSCNODE,"^",3)="") DO ;**DSS ID active, null date
...I +DUPRSLT<1 S ECRESULT="1^"_ECIDDA_"^" ;**1 active DSS ID entry
...I +DUPRSLT>0 S ECRESULT=2 ;**Multiple active DSS ID entries found
...S CONTINUE=0
..I CONTINUE,(DT<$P(ECSCNODE,"^",3)) DO ;**DSS ID active, with date
...;
...;**If one active DSS ID entry
...I +DUPRSLT<1 S ECRESULT="1^"_ECIDDA_"^"_$P(ECSCNODE,"^",3)
...I +DUPRSLT>0 S ECRESULT=2 ;**Multiple active DSS ID entries found
...S CONTINUE=0
Q ECRESULT
;
DUPCHK(ECID,ECIDD1) ; Look for 2nd Stop Code entry
; Input:
; ECID - The DSS ID to check
; ECIDD1 - The IEN for the 1st entry found
;
; Output:
; RSLT - Indicates if a 2nd entry for the DSS ID was found
; Values
; 0 : No second entry was found
; -1 : Second entry found (inactive)
; 1^ien : Second entry found (active)
; 2 : Multiple (active) entries found
N RSLT,NODE0,ACTIVCT,DUPIDCT
S (DUPIDCT,ACTIVCT,RSLT)=0
F S ECIDD1=$O(^DIC(40.7,"C",ECID,ECIDD1)) Q:+ECIDD1=0 DO
.I $D(^DIC(40.7,ECIDD1,0)) DO
..S DUPIDCT=DUPIDCT+1
..S NODE0=^DIC(40.7,ECIDD1,0)
..I ($P(NODE0,"^",3)="")!(DT<+$P(NODE0,"^",3)) DO
...S RSLT="1^"_ECIDD1
...S ACTIVCT=ACTIVCT+1
I DUPIDCT>0,(ACTIVCT=0) S RSLT=-1
I ACTIVCT>1 S RSLT=2
Q RSLT
;
MAIL ; Send message
N DIFROM
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="EC DSS Unit, DSS ID conversion"
S XMTEXT="^TMP(""EC V2.0 P5 INSTALL MSG"","_$J_","
D ^XMD
K XMDUZ,XMY,XMTEXT,XMSUB
K ^TMP("EC V2.0 P5 INSTALL MSG",$J)
Q
;
LINE(TEXT) ; add line to e-mail array
S COUNT=COUNT+1,^TMP("EC V2.0 P5 INSTALL MSG",$J,COUNT)=TEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P5PST 9899 printed Apr 09, 2024@21:02:17 Page 2
EC2P5PST ;ALB/GTS - PATCH EC*2.0*5 Post-Init Rtn ; 8/13/97
+1 ;;2.0; EVENT CAPTURE ;**5**;8 May 96
+2 ;
+3 ;NOTE: This routine is full if it must be broken to 2nd rtn,
+4 ; DUPCHK and SCCHK are the tags to pull into EC2P5P1
+5 ;
TEXT ; Install desc.
+1 ;; This part of the install walks through the DSS file to check
+2 ;; for the existence of an Associated DSS ID (Associated Stop Code).
+3 ;; Those DSS Units not sending data to PCE must have an Associated
+4 ;; DSS ID. If the DSS Units Associated DSS IDs, they are converted
+5 ;; to pointers to the Clinic Stop file (#40.7). DSS Units not having
+6 ;; Associated DSS IDs or having inactive DSS IDs are noted in a message
+7 ;; sent to the installer. The installer should forward the message
+8 ;; to Medical Center personnel responsible for administration of
+9 ;; Event Capture DSS Units.
+10 ;;
+11 ;;QUIT
+12 ;
MSGINTR ; Mail message intro
+1 ;; Installation of EC*2*5 walks through the DSS Unit file to check
+2 ;; the existence of an Associated DSS ID (Associated Stop Code).
+3 ;; DSS Units not sending data to PCE must have an Associated DSS
+4 ;; ID. If the DSS Units have Associated DSS IDs, they are converted
+5 ;; to pointers to the Clinic Stop file (#40.7). Those DSS Units
+6 ;; NOT having Associated DSS IDs or having inactive DSS IDs are noted
+7 ;; in this message. Medical Center personnel responsible for
+8 ;; administration of Event Capture DSS Units should note the items
+9 ;; in this message indicating '**USER EDIT IS REQUIRED**'. Those
+10 ;; items indicating 'User REVIEW suggested' denote DSS IDs which
+11 ;; have been inactivated. The Event Capture option, DSS Units for
+12 ;; Event Capture (Enter/Edit), will allow the user to correct the
+13 ;; Associated DSS ID problems identified in this message.
+14 ;;QUIT
+15 ;
POST ; Set Checkpoint
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("IEN","ENTPOST^EC2P5PST",0)
+3 QUIT
+4 ;
ENTPOST ; Entry point
+1 ;
+2 ;** File #725 mods
DO CRESPEC^EC725P
+3 ;
+4 ;* If X-refs for DBIA 1902 already added, do not reindex
+5 IF $$GET1^DID(721,"","","PACKAGE REVISION DATA")["EC*2*5"
Begin DoDot:1
+6 DO MES^XPDUTL(" ")
+7 DO MES^XPDUTL("EC Patient File #721, Visit field #28 previously reindexed.")
+8 DO MES^XPDUTL(" ")
End DoDot:1
+9 ;
+10 ;* Reindex EC Patient file for DBIA 1902
+11 IF $$GET1^DID(721,"","","PACKAGE REVISION DATA")'["EC*2*5"
DO RNDEX^EC2P5P1
+12 ;
+13 ;* If 724 converted, write message
+14 IF $$GET1^DID(724,"","","PACKAGE REVISION DATA")["EC*2*5"
Begin DoDot:1
+15 DO MES^XPDUTL(" ")
+16 DO MES^XPDUTL("DSS Unit File #724 previously converted from DSS IDs to pointers")
+17 DO MES^XPDUTL("to the Clinic Stop file (#40.7).")
+18 DO MES^XPDUTL(" ")
End DoDot:1
+19 ;
+20 ;* Convert DSS Unit, DSS ID
+21 IF $$GET1^DID(724,"","","PACKAGE REVISION DATA")'["EC*2*5"
DO ENTCNV
+22 QUIT
+23 ;
ENTCNV ; Convert DSS Unit, Associated DSS ID
+1 NEW TXTVAR
+2 DO MES^XPDUTL(" ")
DO MES^XPDUTL(" ")
+3 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(TEXT+I),";;",2)
if TXTVAR="QUIT"
QUIT
Begin DoDot:1
+4 if TXTVAR=""
SET TXTVAR=" "
+5 DO MES^XPDUTL(TXTVAR)
End DoDot:1
+6 DO START
+7 DO KVARS
+8 QUIT
+9 ;
START ; Start proc
+1 SET COUNT=0
+2 ;
+3 DO MES^XPDUTL(" ")
+4 DO MES^XPDUTL("Inspecting Associated DSS IDs in the DSS Unit file.")
+5 ;
+6 ;** Inspect Associated DSS ID
+7 NEW ECDUDA,ECPCE,ECDSSID,ECDSUNME,ECDNODE,MSGTXT,MSGTXT1,MSGTXT2,ECIDVAR
+8 NEW DSSIDSTF
+9 DO LINE(" ")
DO LINE(" ")
+10 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(MSGINTR+I),";;",2)
if TXTVAR="QUIT"
QUIT
Begin DoDot:1
+11 if TXTVAR=""
SET TXTVAR=" "
+12 DO LINE(TXTVAR)
End DoDot:1
+13 SET ECDUDA=+$$PARCP^XPDUTL("IEN")
+14 FOR
SET ECDUDA=$ORDER(^ECD(ECDUDA))
if +ECDUDA=0
QUIT
Begin DoDot:1
+15 IF $DATA(^ECD(ECDUDA,0))
Begin DoDot:2
+16 SET ECDNODE=^ECD(ECDUDA,0)
+17 SET ECPCE=$PIECE(ECDNODE,"^",14)
+18 ;* If Unit not sending to PCE
+19 IF ECPCE=""!(ECPCE="N")
DO NOPCE
+20 IF ECPCE'=""
IF (ECPCE'="N")
DO SENDPCE
End DoDot:2
End DoDot:1
+21 ;** Set VRRV node (file #724)
DO PRD^DILFD(724,"EC*2*5")
+22 DO MAIL
+23 QUIT
+24 ;
KVARS KILL COUNT,Y,I
+1 QUIT
+2 ;
NOPCE ; Process Units NOT sent to PCE
+1 SET ECDSSID=$PIECE(ECDNODE,"^",10)
+2 SET ECDSUNME=$PIECE(ECDNODE,"^",1)
+3 ;* If DSS ID is null
+4 IF ECDSSID=""
Begin DoDot:1
+5 SET MSGTXT="There is no Associated DSS ID for the DSS Unit "_ECDSUNME
+6 DO LINE(" ")
+7 DO LINE(MSGTXT)
+8 DO LINE("**USER EDIT IS REQUIRED**")
End DoDot:1
+9 ;* If DSS ID is not null
+10 IF ECDSSID'=""
Begin DoDot:1
+11 ;* Check 40.7 for DSS ID
SET ECIDVAR=$$SCCHK(+ECDSSID)
+12 ;* DSS ID does not exist
IF +ECIDVAR=-1
IF (+$PIECE(ECIDVAR,"^",2)=0)
Begin DoDot:2
+13 SET MSGTXT="Associated DSS ID for the DSS Unit "_ECDSUNME_" does not exist."
+14 DO LINE(" ")
+15 DO LINE(MSGTXT)
+16 DO LINE("**USER EDIT IS REQUIRED**")
+17 ;**Nullify BAD DSS ID data
DO NULLID
End DoDot:2
+18 ;* DSS ID is inactive
+19 IF +ECIDVAR=-1
IF (+$PIECE(ECIDVAR,"^",2)'=0)
Begin DoDot:2
+20 SET Y=$PIECE(ECIDVAR,"^",3)
+21 DO DD^%DT
+22 SET MSGTXT="Associated DSS ID for the DSS Unit "_ECDSUNME_" was inactivated"
+23 SET MSGTXT1="effective "_Y_". User REVIEW suggested."
+24 DO LINE(" ")
+25 DO LINE(MSGTXT)
+26 DO LINE(MSGTXT1)
+27 ;**Convert to pointer (40.7)
DO CONVRT
End DoDot:2
+28 ;* DSS ID found and active
+29 IF +ECIDVAR=1
Begin DoDot:2
+30 IF +$PIECE(ECIDVAR,"^",3)>0
Begin DoDot:3
+31 SET Y=$PIECE(ECIDVAR,"^",3)
+32 DO DD^%DT
+33 SET MSGTXT="Associated DSS ID for "_ECDSUNME_" was found and is active."
+34 SET MSGTXT1=ECDSSID_" ("_$PIECE(^DIC(40.7,$PIECE(ECIDVAR,"^",2),0),"^",1)_") will become"
+35 SET MSGTXT2="inactive on "_Y_", however. (User information only.)"
+36 DO LINE(" ")
+37 DO LINE(MSGTXT)
+38 DO LINE(MSGTXT1)
+39 DO LINE(MSGTXT2)
End DoDot:3
+40 ;**Convert to pointer (40.7)
DO CONVRT
End DoDot:2
+41 IF +ECIDVAR=2
Begin DoDot:2
+42 SET MSGTXT="Associated DSS ID "_ECDSSID_" for the DSS Unit "_ECDSUNME
+43 SET MSGTXT1="has multiple DSS ID Names. **USER EDIT IS REQUIRED**"
+44 DO LINE(" ")
+45 DO LINE(MSGTXT)
+46 DO LINE(MSGTXT1)
+47 ;**Nullify BAD DSS ID data
DO NULLID
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
SENDPCE ; Process units sent to PCE
+1 SET ECDSSID=$PIECE(ECDNODE,"^",10)
+2 SET ECDSUNME=$PIECE(ECDNODE,"^",1)
+3 ;* If DSS ID is not Null
+4 IF ECDSSID'=""
Begin DoDot:1
+5 ;* Check 40.7 for DSS ID
SET ECIDVAR=$$SCCHK(+ECDSSID)
+6 IF +ECIDVAR'=1
Begin DoDot:2
+7 SET MSGTXT="Associated DSS ID for "_ECDSUNME_" was either not found, is inactive or has"
+8 SET MSGTXT1="multiple active DSS ID names."
+9 SET MSGTXT2=ECDSSID_" was removed from "_ECDSUNME_"."
+10 DO LINE(" ")
+11 DO LINE(MSGTXT)
+12 DO LINE(MSGTXT1)
+13 DO LINE(MSGTXT2)
+14 DO LINE("User Information only. Events for this unit are not sent to PCE")
+15 ;**Nullify BAD DSS ID data
DO NULLID
End DoDot:2
+16 IF +ECIDVAR=1
Begin DoDot:2
+17 SET MSGTXT="Associated DSS ID for "_ECDSUNME_" converted for "_ECDSSID_"."
+18 DO LINE(" ")
+19 DO LINE(MSGTXT)
+20 DO LINE("User Information only. Events for this unit are not sent to PCE")
+21 ;**Convert to pointer (40.7)
DO CONVRT
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
CONVRT ; Convert DSS ID to pointer
+1 ; Required variables (defined)
+2 ; ECIDVAR - Result of SCCHK
+3 ; ECDUDA - IEN of DSS Unit processing
+4 ; DSSIDSTF - Must be NEW'ed prior to calling
+5 ;
+6 SET DSSIDSTF=$PIECE(ECIDVAR,"^",2)
+7 SET DIE="^ECD("
SET DA=ECDUDA
SET DR="9////^S X=DSSIDSTF"
+8 DO ^DIE
+9 NEW %
+10 SET %=$$UPCP^XPDUTL("IEN",ECDUDA)
+11 KILL DIE,DA,DR
+12 QUIT
+13 ;
NULLID ; Nullify BAD DSS IDs
+1 ; Required variables (defined)
+2 ; ECDUDA - IEN of DSS Unit processing
+3 ;
+4 SET DIE="^ECD("
SET DA=ECDUDA
SET DR="9////@"
+5 DO ^DIE
+6 NEW %
+7 SET %=$$UPCP^XPDUTL("IEN",ECDUDA)
+8 KILL DIE,DA,DR
+9 QUIT
+10 ;
SCCHK(ECDSSID) ; Check 40.7 for DSS ID
+1 ; Input:
+2 ; ECDSSID - The DSS ID to check
+3 ;
+4 ; Output:
+5 ; ECRESULT - Indicates if the DSS ID was found
+6 ; Values
+7 ; -1 : DSS ID was not found
+8 ; -1^ien^Inactivation date : DSS ID found but is inactive
+9 ; 1^ien^Inactivation date : DSS ID found and is active
+10 ; Pce 3=null if no inactv date
+11 ; 2 : Multiple active entries found
+12 ;
+13 NEW ECRESULT,ECIDDA,CONTINUE,ECSCNODE,DUPRSLT
+14 SET CONTINUE=1
+15 SET ECRESULT=-1
+16 IF CONTINUE
IF ($DATA(^DIC(40.7,"C",ECDSSID)))
Begin DoDot:1
+17 SET ECIDDA=$ORDER(^DIC(40.7,"C",ECDSSID,""))
+18 ;**DSS ID does not exist
IF CONTINUE
IF (+ECIDDA'>0)
SET CONTINUE=0
+19 ;**DSS ID exists
IF CONTINUE
IF ($DATA(^DIC(40.7,ECIDDA,0)))
Begin DoDot:2
+20 SET ECSCNODE=^DIC(40.7,ECIDDA,0)
+21 SET DUPRSLT=$$DUPCHK(ECDSSID,ECIDDA)
+22 IF CONTINUE
IF ($PIECE(ECSCNODE,"^",3)'="")
Begin DoDot:3
+23 ;**DSS ID inactive
IF CONTINUE
IF (DT>$PIECE(ECSCNODE,"^",3))
Begin DoDot:4
+24 ;**Only one entry (inactive) for DSS ID
IF +DUPRSLT<1
Begin DoDot:5
+25 SET ECRESULT="-1^"_ECIDDA_"^"_$PIECE(ECSCNODE,"^",3)
End DoDot:5
+26 ;**An active DSS ID found
IF +DUPRSLT=1
Begin DoDot:5
+27 SET ECRESULT="1^"_$PIECE(DUPRSLT,"^",2)_"^"_$PIECE(^DIC(40.7,$PIECE(DUPRSLT,"^",2),0),"^",3)
End DoDot:5
+28 ;**Multiple active DSS IDs found
IF +DUPRSLT=2
Begin DoDot:5
+29 SET ECRESULT=2
End DoDot:5
+30 SET CONTINUE=0
End DoDot:4
End DoDot:3
+31 ;**DSS ID active, null date
IF CONTINUE
IF ($PIECE(ECSCNODE,"^",3)="")
Begin DoDot:3
+32 ;**1 active DSS ID entry
IF +DUPRSLT<1
SET ECRESULT="1^"_ECIDDA_"^"
+33 ;**Multiple active DSS ID entries found
IF +DUPRSLT>0
SET ECRESULT=2
+34 SET CONTINUE=0
End DoDot:3
+35 ;**DSS ID active, with date
IF CONTINUE
IF (DT<$PIECE(ECSCNODE,"^",3))
Begin DoDot:3
+36 ;
+37 ;**If one active DSS ID entry
+38 IF +DUPRSLT<1
SET ECRESULT="1^"_ECIDDA_"^"_$PIECE(ECSCNODE,"^",3)
+39 ;**Multiple active DSS ID entries found
IF +DUPRSLT>0
SET ECRESULT=2
+40 SET CONTINUE=0
End DoDot:3
End DoDot:2
End DoDot:1
+41 QUIT ECRESULT
+42 ;
DUPCHK(ECID,ECIDD1) ; Look for 2nd Stop Code entry
+1 ; Input:
+2 ; ECID - The DSS ID to check
+3 ; ECIDD1 - The IEN for the 1st entry found
+4 ;
+5 ; Output:
+6 ; RSLT - Indicates if a 2nd entry for the DSS ID was found
+7 ; Values
+8 ; 0 : No second entry was found
+9 ; -1 : Second entry found (inactive)
+10 ; 1^ien : Second entry found (active)
+11 ; 2 : Multiple (active) entries found
+12 NEW RSLT,NODE0,ACTIVCT,DUPIDCT
+13 SET (DUPIDCT,ACTIVCT,RSLT)=0
+14 FOR
SET ECIDD1=$ORDER(^DIC(40.7,"C",ECID,ECIDD1))
if +ECIDD1=0
QUIT
Begin DoDot:1
+15 IF $DATA(^DIC(40.7,ECIDD1,0))
Begin DoDot:2
+16 SET DUPIDCT=DUPIDCT+1
+17 SET NODE0=^DIC(40.7,ECIDD1,0)
+18 IF ($PIECE(NODE0,"^",3)="")!(DT<+$PIECE(NODE0,"^",3))
Begin DoDot:3
+19 SET RSLT="1^"_ECIDD1
+20 SET ACTIVCT=ACTIVCT+1
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF DUPIDCT>0
IF (ACTIVCT=0)
SET RSLT=-1
+22 IF ACTIVCT>1
SET RSLT=2
+23 QUIT RSLT
+24 ;
MAIL ; Send message
+1 NEW DIFROM
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB="EC DSS Unit, DSS ID conversion"
+4 SET XMTEXT="^TMP(""EC V2.0 P5 INSTALL MSG"","_$JOB_","
+5 DO ^XMD
+6 KILL XMDUZ,XMY,XMTEXT,XMSUB
+7 KILL ^TMP("EC V2.0 P5 INSTALL MSG",$JOB)
+8 QUIT
+9 ;
LINE(TEXT) ; add line to e-mail array
+1 SET COUNT=COUNT+1
SET ^TMP("EC V2.0 P5 INSTALL MSG",$JOB,COUNT)=TEXT
+2 QUIT
