AUPN9920 ;IHS/OIT/FBD - AUPN 99.1 PATCH 20 ;
;;99.1;IHS DICTIONARIES (PATIENT);**20**;MAR 9, 1999
;
;
ENV ;ENVIROMENT CHECK
I '$G(IOM) D HOME^%ZIS
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM)
;
NEW IORVON,IORVOFF
S X="IORVON;IORVOFF"
D ENDR^%ZISS
;
I $$VCHK("DI","22.0",2)
I $$VCHK("XU","8.0",2)
I $$VCHK("AUPN","99.1",2)
;
I '$$INSTALLD("AUPN*99.1*19") D SORRY(2)
I '$$INSTALLD("AUT*98.1*23") D SORRY(2)
;
NEW DA,DIC
S X="AUPN",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AUPN")) D Q
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUPN"" prefix.",IOM)
. W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
. D SORRY(2)
.Q
;
I $G(XPDQUIT) W !,$$CJ^XLFSTR(IORVON_"FIX IT! Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
;
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPO1"),XPDDIQ("XPI1"))=0
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(3)
Q ;ENVIRONMENT CHECK EXIT
;
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
;
;
VCHK(AUPNPRE,AUPNVER,AUPNQUIT) ; Check versions needed.
;
NEW AUPNV
S AUPNV=$$VERSION^XPDUTL(AUPNPRE)
W !,$$CJ^XLFSTR("Need at least "_AUPNPRE_" v "_AUPNVER_"....."_AUPNPRE_" v "_AUPNV_" Present",IOM)
I AUPNV<AUPNVER D SORRY(AUPNQUIT) Q 0
Q 1
;
;
POST ;EP - APUN V99.1 PATCH 20 POST-INIT
;
XREF ;BUILD NEW CROSS-REFERENCES
;
;PATIENT FILE (9000001), DATE OF LAST UPDATE (.16), ADLU XREF
;
D BMES^XPDUTL("Creating new PATIENT file cross-reference...")
K ^AUPNPAT("ADLU")
K DIK
S DIK(1)=".16^ADLU",DIK="^AUPNPAT("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;MEDICARE ELIGIBLE FILE (9000003), DATE OF LAST UPDATE (.07), ADLU XREF
;
D BMES^XPDUTL("Creating new MEDICARE ELIGIBLE file cross-reference...")
K ^AUPNMCR("ADLU")
K DIK
S DIK(1)=".07^ADLU",DIK="^AUPNMCR("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;MEDICAID ELIGIBLE FILE (9000004), DATE OF LAST UPDATE (.08), ADLU XREF
;
D BMES^XPDUTL("Creating new MEDICAID ELIGIBLE file cross-reference...")
K ^AUPNMCD("ADLU")
K DIK
S DIK(1)=".08^ADLU",DIK="^AUPNMCD("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;RAILROAD ELIGIBLE FILE (9000005), DATE OF LAST UPDATE (.07), ADLU XREF
;
D BMES^XPDUTL("Creating new MEDICARE ELIGIBLE file cross-reference...")
K ^AUPNMCR("ADLU")
K DIK
S DIK(1)=".07^ADLU",DIK="^AUPNMCR("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;PRIVATE INSURANCE ELIGIBLE FILE (9000003)/INSURER SUBFIELD (1101), VERIFIED COVERAGE DATE (.09), AVCD XREF
;
D BMES^XPDUTL("Creating new PRIVATE INSURANCE ELIGIBLE file cross-reference...")
K ^AUPNPRVT("AVCD")
S AUPNPIEN=0 ;PRIVATE INSURANCE ELIGIBLE IEN
F S AUPNPIEN=$O(^AUPNPRVT(AUPNPIEN)) Q:+AUPNPIEN'=AUPNPIEN D
.K DA,DIK
.S DA(1)=AUPNPIEN
.S DIK="^AUPNPRVT("_AUPNPIEN_",11,"
.S DIK(1)=".09^AVCD"
.D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;VISIT FILE (9000010), DATE LAST MODIFIED (.13), ADLM XREF
;
D BMES^XPDUTL("Creating new VISIT file cross-reference...")
K ^AUPNVSIT("ADLM")
K DIK
S DIK(1)=".13^ADLM",DIK="^AUPNVSIT("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;PROBLEM FILE (9000011), DATE LAST MODIFIED (.03), ADLM XREF
;
D BMES^XPDUTL("Creating new PROBLEM file cross-reference...")
K ^AUPNPROB("ADLM")
K DIK
S DIK(1)=".03^ADLM",DIK="^AUPNPROB("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;PATIENT REFUSALS FOR SERVICE/NMI FILE (9000022), DATE LAST MODIFIED (.08), ADLM XREF
;
D BMES^XPDUTL("Creating new PATIENT REFUSALS FOR SERVICE/NMI file cross-reference...")
K ^AUPNPREF("ADLM")
K DIK
S DIK(1)=".08^ADLM",DIK="^AUPNPREF("
D ENALL^DIK
D MES^XPDUTL("Complete.")
;
;
;
D BMES^XPDUTL("Delivering AUPN*99.1*20 install message to select users...")
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("AUPN9920",$J)
S ^TMP("AUPN9920",$J,1)=" --- AUPN v 99.1, Patch 20, has been installed into this uci ---"
S %=0
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AUPN9920",$J,(%+1))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUPN9920"",$J,",XMY(1)="",XMY(DUZ)=""
F %="AGZMENU","APCDZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("AUPN9920",$J)
Q
;
SINGLE(K) ; Get holders of a single key K.
NEW Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
INSTALLD(AUPNSTAL) ;EP - Determine if patch AUPNSTAL was installed, where
; AUPNSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW AUPNY,DIC,X,Y
S X=$P(AUPNSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(AUPNSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AUPNSTAL,"*",3)
D ^DIC
S AUPNY=Y
D IMES
Q $S(AUPNY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
;
AUPN9920 ;IHS/OIT/FBD - AUPN 99.1 PATCH 20 ;
+1 ;;99.1;IHS DICTIONARIES (PATIENT);**20**;MAR 9, 1999
+2 ;
+3 ;
ENV ;ENVIROMENT CHECK
+1 IF '$GET(IOM)
DO HOME^%ZIS
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+9 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM)
+10 ;
+11 NEW IORVON,IORVOFF
+12 SET X="IORVON;IORVOFF"
+13 DO ENDR^%ZISS
+14 ;
+15 IF $$VCHK("DI","22.0",2)
+16 IF $$VCHK("XU","8.0",2)
+17 IF $$VCHK("AUPN","99.1",2)
+18 ;
+19 IF '$$INSTALLD("AUPN*99.1*19")
DO SORRY(2)
+20 IF '$$INSTALLD("AUT*98.1*23")
DO SORRY(2)
+21 ;
+22 NEW DA,DIC
+23 SET X="AUPN"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+24 DO IX^DIC
+25 IF Y<0
IF $DATA(^DIC(9.4,"C","AUPN"))
Begin DoDot:1
+26 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUPN"" prefix.",IOM)
+27 WRITE !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
+28 DO SORRY(2)
+29 QUIT
End DoDot:1
QUIT
+30 ;
+31 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR(IORVON_"FIX IT! Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7
QUIT
+32 ;
+33 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPO1"),XPDDIQ("XPI1"))=0
+34 ;
+35 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+36 ;
+37 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(3)
+38 ;ENVIRONMENT CHECK EXIT
QUIT
+39 ;
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
+6 ;
+7 ;
VCHK(AUPNPRE,AUPNVER,AUPNQUIT) ; Check versions needed.
+1 ;
+2 NEW AUPNV
+3 SET AUPNV=$$VERSION^XPDUTL(AUPNPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_AUPNPRE_" v "_AUPNVER_"....."_AUPNPRE_" v "_AUPNV_" Present",IOM)
+5 IF AUPNV<AUPNVER
DO SORRY(AUPNQUIT)
QUIT 0
+6 QUIT 1
+7 ;
+8 ;
POST ;EP - APUN V99.1 PATCH 20 POST-INIT
+1 ;
XREF ;BUILD NEW CROSS-REFERENCES
+1 ;
+2 ;PATIENT FILE (9000001), DATE OF LAST UPDATE (.16), ADLU XREF
+3 ;
+4 DO BMES^XPDUTL("Creating new PATIENT file cross-reference...")
+5 KILL ^AUPNPAT("ADLU")
+6 KILL DIK
+7 SET DIK(1)=".16^ADLU"
SET DIK="^AUPNPAT("
+8 DO ENALL^DIK
+9 DO MES^XPDUTL("Complete.")
+10 ;
+11 ;MEDICARE ELIGIBLE FILE (9000003), DATE OF LAST UPDATE (.07), ADLU XREF
+12 ;
+13 DO BMES^XPDUTL("Creating new MEDICARE ELIGIBLE file cross-reference...")
+14 KILL ^AUPNMCR("ADLU")
+15 KILL DIK
+16 SET DIK(1)=".07^ADLU"
SET DIK="^AUPNMCR("
+17 DO ENALL^DIK
+18 DO MES^XPDUTL("Complete.")
+19 ;
+20 ;MEDICAID ELIGIBLE FILE (9000004), DATE OF LAST UPDATE (.08), ADLU XREF
+21 ;
+22 DO BMES^XPDUTL("Creating new MEDICAID ELIGIBLE file cross-reference...")
+23 KILL ^AUPNMCD("ADLU")
+24 KILL DIK
+25 SET DIK(1)=".08^ADLU"
SET DIK="^AUPNMCD("
+26 DO ENALL^DIK
+27 DO MES^XPDUTL("Complete.")
+28 ;
+29 ;RAILROAD ELIGIBLE FILE (9000005), DATE OF LAST UPDATE (.07), ADLU XREF
+30 ;
+31 DO BMES^XPDUTL("Creating new MEDICARE ELIGIBLE file cross-reference...")
+32 KILL ^AUPNMCR("ADLU")
+33 KILL DIK
+34 SET DIK(1)=".07^ADLU"
SET DIK="^AUPNMCR("
+35 DO ENALL^DIK
+36 DO MES^XPDUTL("Complete.")
+37 ;
+38 ;PRIVATE INSURANCE ELIGIBLE FILE (9000003)/INSURER SUBFIELD (1101), VERIFIED COVERAGE DATE (.09), AVCD XREF
+39 ;
+40 DO BMES^XPDUTL("Creating new PRIVATE INSURANCE ELIGIBLE file cross-reference...")
+41 KILL ^AUPNPRVT("AVCD")
+42 ;PRIVATE INSURANCE ELIGIBLE IEN
SET AUPNPIEN=0
+43 FOR
SET AUPNPIEN=$ORDER(^AUPNPRVT(AUPNPIEN))
IF +AUPNPIEN'=AUPNPIEN
QUIT
Begin DoDot:1
+44 KILL DA,DIK
+45 SET DA(1)=AUPNPIEN
+46 SET DIK="^AUPNPRVT("_AUPNPIEN_",11,"
+47 SET DIK(1)=".09^AVCD"
+48 DO ENALL^DIK
End DoDot:1
+49 DO MES^XPDUTL("Complete.")
+50 ;
+51 ;VISIT FILE (9000010), DATE LAST MODIFIED (.13), ADLM XREF
+52 ;
+53 DO BMES^XPDUTL("Creating new VISIT file cross-reference...")
+54 KILL ^AUPNVSIT("ADLM")
+55 KILL DIK
+56 SET DIK(1)=".13^ADLM"
SET DIK="^AUPNVSIT("
+57 DO ENALL^DIK
+58 DO MES^XPDUTL("Complete.")
+59 ;
+60 ;PROBLEM FILE (9000011), DATE LAST MODIFIED (.03), ADLM XREF
+61 ;
+62 DO BMES^XPDUTL("Creating new PROBLEM file cross-reference...")
+63 KILL ^AUPNPROB("ADLM")
+64 KILL DIK
+65 SET DIK(1)=".03^ADLM"
SET DIK="^AUPNPROB("
+66 DO ENALL^DIK
+67 DO MES^XPDUTL("Complete.")
+68 ;
+69 ;PATIENT REFUSALS FOR SERVICE/NMI FILE (9000022), DATE LAST MODIFIED (.08), ADLM XREF
+70 ;
+71 DO BMES^XPDUTL("Creating new PATIENT REFUSALS FOR SERVICE/NMI file cross-reference...")
+72 KILL ^AUPNPREF("ADLM")
+73 KILL DIK
+74 SET DIK(1)=".08^ADLM"
SET DIK="^AUPNPREF("
+75 DO ENALL^DIK
+76 DO MES^XPDUTL("Complete.")
+77 ;
+78 ;
+79 ;
+80 DO BMES^XPDUTL("Delivering AUPN*99.1*20 install message to select users...")
+81 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+82 KILL ^TMP("AUPN9920",$JOB)
+83 SET ^TMP("AUPN9920",$JOB,1)=" --- AUPN v 99.1, Patch 20, has been installed into this uci ---"
+84 SET %=0
+85 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AUPN9920",$JOB,(%+1))=" "_^(%,0)
+86 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AUPN9920"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+87 FOR %="AGZMENU","APCDZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+88 DO ^XMD
+89 KILL ^TMP("AUPN9920",$JOB)
+90 QUIT
+91 ;
SINGLE(K) ; Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ;
INSTALLD(AUPNSTAL) ;EP - Determine if patch AUPNSTAL was installed, where
+1 ; AUPNSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW AUPNY,DIC,X,Y
+4 SET X=$PIECE(AUPNSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AUPNSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AUPNSTAL,"*",3)
+12 DO ^DIC
+13 SET AUPNY=Y
+14 DO IMES
+15 QUIT $SELECT(AUPNY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
+3 ;
