DG53856P ;BIR/CKN-PATCH DG*5.3*856 POST INSTALLATION ROUTINE ; 5/15/12 6:12pm
;;5.3;Registration;**856**;Aug 13, 1993;Build 5
Q
EP ;**856 (ckn)
;Do not run module if patch DG*5.3*856 previously installed.
I $$PATCH^XPDUTL("DG*5.3*856") D BMES^XPDUTL("The AISS cross-reference previously created; no action needed.") Q
AGN D BMES^XPDUTL("Creating AISS cross-reference on the TREATING FACILITY LIST #391.91 file.")
N ZTRTN,ZTDESC,ZTSK
S ZTRTN="EN^DG53856P",ZTDESC="DG53856P - INDEX TREATING FACILITY FILE"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
I $D(ZTSK) D BMES^XPDUTL("Look for the completion of task #"_ZTSK_" in Taskman.") D MES^XPDUTL("When the task finishes, the AISS cross-reference has been created.")
S:$D(ZTQUEUED) ZTREQ="@"
Q
EN ;
N SID,TFIEN,AA,IDTYP,SITE,SITEN,NODE0,NODE2
S TFIEN=0
F S TFIEN=$O(^DGCN(391.91,TFIEN)) Q:'TFIEN D
. S NODE0=$G(^DGCN(391.91,TFIEN,0))
. S SITE=$P(NODE0,"^",2)
. S IDTYP=$P(NODE0,"^",9)
. S NODE2=$G(^DGCN(391.91,TFIEN,2))
. S AA=$P(NODE2,"^"),SID=$P(NODE2,"^",2)
. S SITEN=$$STA^XUAF4(SITE)
. I SITEN="200DOD" D
.. N FDA
.. I AA'="USDOD" S AA="USDOD",FDA(1,391.91,+TFIEN_",",10)=AA
.. I IDTYP'="NI" S IDTYP="NI",FDA(1,391.91,+TFIEN_",",.09)=IDTYP
.. I $D(FDA) D FILE^DIE("K","FDA(1)","ERR")
.. K FDA
. I SITEN["200N" D
.. N FDA
.. I IDTYP="" S IDTYP="NI"
.. I AA'="" S FDA(1,391.91,+TFIEN_",",.09)=IDTYP
.. I $D(FDA) D FILE^DIE("K","FDA(1)","ERR")
.. K FDA
. I AA'="",IDTYP'="",SITE'="",SID'="" D
.. S ^DGCN(391.91,"AISS",$E(SID,1,150),$E(AA,1,70),$E(IDTYP,1,10),$E(SITE,1,10),TFIEN)=""
Q
;
RERUN ;If the AISS cross-reference must be deleted and recreated
;by Product Support, use this line tag.
K ^DGCN(391.91,"AISS")
D AGN^DG53856P
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53856P 1758 printed Sep 23, 2025@20:14:56 Page 2
DG53856P ;BIR/CKN-PATCH DG*5.3*856 POST INSTALLATION ROUTINE ; 5/15/12 6:12pm
+1 ;;5.3;Registration;**856**;Aug 13, 1993;Build 5
+2 QUIT
EP ;**856 (ckn)
+1 ;Do not run module if patch DG*5.3*856 previously installed.
+2 IF $$PATCH^XPDUTL("DG*5.3*856")
DO BMES^XPDUTL("The AISS cross-reference previously created; no action needed.")
QUIT
AGN DO BMES^XPDUTL("Creating AISS cross-reference on the TREATING FACILITY LIST #391.91 file.")
+1 NEW ZTRTN,ZTDESC,ZTSK
+2 SET ZTRTN="EN^DG53856P"
SET ZTDESC="DG53856P - INDEX TREATING FACILITY FILE"
+3 SET ZTIO=""
SET ZTDTH=$HOROLOG
+4 DO ^%ZTLOAD
+5 IF $DATA(ZTSK)
DO BMES^XPDUTL("Look for the completion of task #"_ZTSK_" in Taskman.")
DO MES^XPDUTL("When the task finishes, the AISS cross-reference has been created.")
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
EN ;
+1 NEW SID,TFIEN,AA,IDTYP,SITE,SITEN,NODE0,NODE2
+2 SET TFIEN=0
+3 FOR
SET TFIEN=$ORDER(^DGCN(391.91,TFIEN))
if 'TFIEN
QUIT
Begin DoDot:1
+4 SET NODE0=$GET(^DGCN(391.91,TFIEN,0))
+5 SET SITE=$PIECE(NODE0,"^",2)
+6 SET IDTYP=$PIECE(NODE0,"^",9)
+7 SET NODE2=$GET(^DGCN(391.91,TFIEN,2))
+8 SET AA=$PIECE(NODE2,"^")
SET SID=$PIECE(NODE2,"^",2)
+9 SET SITEN=$$STA^XUAF4(SITE)
+10 IF SITEN="200DOD"
Begin DoDot:2
+11 NEW FDA
+12 IF AA'="USDOD"
SET AA="USDOD"
SET FDA(1,391.91,+TFIEN_",",10)=AA
+13 IF IDTYP'="NI"
SET IDTYP="NI"
SET FDA(1,391.91,+TFIEN_",",.09)=IDTYP
+14 IF $DATA(FDA)
DO FILE^DIE("K","FDA(1)","ERR")
+15 KILL FDA
End DoDot:2
+16 IF SITEN["200N"
Begin DoDot:2
+17 NEW FDA
+18 IF IDTYP=""
SET IDTYP="NI"
+19 IF AA'=""
SET FDA(1,391.91,+TFIEN_",",.09)=IDTYP
+20 IF $DATA(FDA)
DO FILE^DIE("K","FDA(1)","ERR")
+21 KILL FDA
End DoDot:2
+22 IF AA'=""
IF IDTYP'=""
IF SITE'=""
IF SID'=""
Begin DoDot:2
+23 SET ^DGCN(391.91,"AISS",$EXTRACT(SID,1,150),$EXTRACT(AA,1,70),$EXTRACT(IDTYP,1,10),$EXTRACT(SITE,1,10),TFIEN)=""
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
RERUN ;If the AISS cross-reference must be deleted and recreated
+1 ;by Product Support, use this line tag.
+2 KILL ^DGCN(391.91,"AISS")
+3 DO AGN^DG53856P
+4 QUIT
+5 ;
