- 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 Jan 18, 2025@02:57: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