Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EC2P5PST

EC2P5PST.m

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