ABSPOSZ ; IHS/FCS/DRS - Upgrades ;
;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
Q
; Upgrades for files are in ABSPOSZA. Only needed at a couple of
; places, so run them manually, separately.
;
PRE ; Pre-installation procedure, pointed to by .KID file
; If you have renamed any 9002313.92 entries, ; look up the existing ones at this site and rename them.
; Otherwise, resolving of pointers will fail, won't it?
Q
POST ; Post-installation procedure, pointed to by .KID file
I $$HASILCAR D BILLMENU
I DUZ(2)=1665 D ANMC
D INIT58
D T1ADDR
K ^ABSP(9002313.99,"ABSPOSM1") ; node erroneously set in earlier ver.
Q
;
T1ADDR ; the "ENVOY DIRECT VIA T1 LINE" dialout - make sure it has the
; latest and correct address and port information
N T1 S T1=$$T1 I 'T1 D Q
. W !,"There is no dial out named ",$$T1NAME,!
N X S X=$G(^ABSP(9002313.55,T1,"SERVER"))
;
; T1VALUES points directly inside Envoy.
; CLOVERLF is that special new project, the address we ultimately
; do want to send to. Pick the CLOVERLF value starting some date,
; which is when I'm guessing they will be done testing and ready to
; do production business.
; Some sites may still need to manually edit the values if my guess
; is far off the actual completion date of Cloverleaf.
; Cloverleaf may assign specific ports to specific sites,
; so don't change the port number if the correct IP address is already
; in place.
;
; ABSP*1.0T7*7 - Cloverleaf effective date is uncertain.
; For now, always install the Envoy IP address and port
;N Y S Y=$P($S(DT<3010701:$T(T1VALUES),1:$T(CLOVERLF)),";",2) ;
N Y S Y=$P($T(T1VALUES),";",2) ; ABSP*1.0T7*7
I X=Y Q ; already has correct values
W !!,"Updating your settings for the ",$$T1NAME," dial out...",! H 2
I $P(X,U)'=$P(Y,U) D
. W "Changing the IP address from ",$P(X,U)," to ",$P(Y,U),! H 2
. S $P(X,U)=$P(Y,U)
. W "Changing the TCP port from ",$P(X,U,2)," to ",$P(Y,U,2),! H 2
. S $P(X,U,2)=$P(Y,U,2)
E I $P(X,U,2)="" D
. W "Setting the TCP port to ",$P(Y,U,2),! H 2
. S $P(X,U,2)=$P(Y,U,2)
S ^ABSP(9002313.55,T1,"SERVER")=X
W !,"Settings for ",$$T1NAME," have been updated.",! H 2
W !
W "If you customized any dial outs to also point to the T1 address",!
W "and port, you will need to update those manually using the",! H 1
W "MGR/SET/DIAL menu to set up the dial outs.",! H 2
Q
T1VALUES ;199.244.222.6^6802
CLOVERLF ;161.223.90.56^5006
T1() Q $O(^ABSP(9002313.55,"B",$$T1NAME,0))
T1NAME() Q "ENVOY DIRECT VIA T1 LINE"
ANMC ; Special for ANMC
; Rename the receipt protocol
; Lookup the ABSP P1 RECEIPT protocol
; and change its ITEM TEXT (#1) to "Print DUR data"
W !,"Renaming the ABSP P1 RECEIPT protocol's ITEM TEXT...",!
N PRO S PRO=$$FIND1^DIC(101,,,"ABSP P1 RECEIPT")
I 'PRO W "Could not find it!",! Q
S PRO=PRO_","
N FDA,MSG S FDA(101,PRO,1)="Print DUR data"
D FILE^DIE(,"FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("ANMC+10^ABSPOSZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) W "Error in FILE^DIE: ",! D ZWRITE^ABSPOS("MSG") Q
W "Done",!
;
; File 101, Subfile 101.01, Field .01
; Lookup which one points to ABSP P1 RECEIPT
; and change its Mnemonic (#2) to "DUR"
;
W "Finding the menu in ABSP PROTOCOL 1...",!
N PRO1
S PRO=$$FIND1^DIC(101,,,"ABSP PROTOCOL 1") ; top-level protocol
I 'PRO W "Could not find it!",! Q
S PRO=PRO_","
W "Finding the ABSP P1 RECEIPT among the ITEMs therein...",!
S PRO1=$$FIND1^DIC(101.01,","_PRO,,"ABSP P1 RECEIPT")
I 'PRO1 W "Could not find it!",! Q
K FDA,MSG S FDA(101.01,PRO1_","_PRO,2)="DUR"
D FILE^DIE(,"FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("ANMC+28^ABSPOSZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) W "Error in FILE^DIE: ",! D ZWRITE^ABSPOS("MSG") Q
W "Done",!
Q
HASILCAR() ; does the site have ILC A/R installed and active?
; This is for use only by installation procedure!
; Look at the most recently created bill. See if it was in the
; past week or so.
N PCN S PCN=$P($G(^ABSBITMS(9002302,0)),U,3)
I 'PCN Q 0
N X1,X2,X,%Y S X2=$P($G(^ABSBITMS(9002302,PCN,4)),U) ; date created
I 'X2 Q 0 ; impossible
S X1=DT D ^%DTC
Q X<9
; change the ITEM named ABSP BILLING MENU
; to ABSP BILLING MENU FOR ILC A/R
W !,"ILC A/R detected!",!
W !,"As a result, we now make a change to the correct billing menu.",!
N MAINMENU S MAINMENU=$$FIND1^DIC(19,,"X","ABSPMENU")
I 'MAINMENU W !!?10,"Couldn't find ABSPMENU in file 19??",! Q
N BILLMENU
S BILLMENU=$$FIND1^DIC(19.01,","_MAINMENU_",","X","ABSP BILLING MENU")
I 'BILLMENU W !!?10,"Couldn't find ABSP BILLING MENU in ABSPMENU??",! Q
N FDA,MSG S FDA(19.01,BILLMENU_","_MAINMENU_",",.01)="ABSP BILLING MENU FOR ILC A/R"
D FILE^DIE("E","FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("BILLMENU^ABSPOSZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D
. W !!?10,"Failed to change the BILLING MENU item",!
. D ZWRITE^ABSPOS("FDA","MSG")
Q
INIT58 ; Make sure there's an entry in file 9002313.58
I $P(^ABSPECX("S",0),U,3) Q ; already is one
N FDA,MSG
S FDA(9002313.58,"+1,",.01)=1
D UPDATE^DIE(,"FDA",,"MSG")
I $D(MSG) D LOG^ABSPOSL2("INIT58^ABSPOSZ",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q
ABSPOSZ ; IHS/FCS/DRS - Upgrades ;
+1 ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
+2 QUIT
+3 ; Upgrades for files are in ABSPOSZA. Only needed at a couple of
+4 ; places, so run them manually, separately.
+5 ;
PRE ; Pre-installation procedure, pointed to by .KID file
+1 ; If you have renamed any 9002313.92 entries, ; look up the existing ones at this site and rename them.
+2 ; Otherwise, resolving of pointers will fail, won't it?
+3 QUIT
POST ; Post-installation procedure, pointed to by .KID file
+1 IF $$HASILCAR
DO BILLMENU
+2 IF DUZ(2)=1665
DO ANMC
+3 DO INIT58
+4 DO T1ADDR
+5 ; node erroneously set in earlier ver.
KILL ^ABSP(9002313.99,"ABSPOSM1")
+6 QUIT
+7 ;
T1ADDR ; the "ENVOY DIRECT VIA T1 LINE" dialout - make sure it has the
+1 ; latest and correct address and port information
+2 NEW T1
SET T1=$$T1
IF 'T1
Begin DoDot:1
+3 WRITE !,"There is no dial out named ",$$T1NAME,!
End DoDot:1
QUIT
+4 NEW X
SET X=$GET(^ABSP(9002313.55,T1,"SERVER"))
+5 ;
+6 ; T1VALUES points directly inside Envoy.
+7 ; CLOVERLF is that special new project, the address we ultimately
+8 ; do want to send to. Pick the CLOVERLF value starting some date,
+9 ; which is when I'm guessing they will be done testing and ready to
+10 ; do production business.
+11 ; Some sites may still need to manually edit the values if my guess
+12 ; is far off the actual completion date of Cloverleaf.
+13 ; Cloverleaf may assign specific ports to specific sites,
+14 ; so don't change the port number if the correct IP address is already
+15 ; in place.
+16 ;
+17 ; ABSP*1.0T7*7 - Cloverleaf effective date is uncertain.
+18 ; For now, always install the Envoy IP address and port
+19 ;N Y S Y=$P($S(DT<3010701:$T(T1VALUES),1:$T(CLOVERLF)),";",2) ;
+20 ; ABSP*1.0T7*7
NEW Y
SET Y=$PIECE($TEXT(T1VALUES),";",2)
+21 ; already has correct values
IF X=Y
QUIT
+22 WRITE !!,"Updating your settings for the ",$$T1NAME," dial out...",!
HANG 2
+23 IF $PIECE(X,U)'=$PIECE(Y,U)
Begin DoDot:1
+24 WRITE "Changing the IP address from ",$PIECE(X,U)," to ",$PIECE(Y,U),!
HANG 2
+25 SET $PIECE(X,U)=$PIECE(Y,U)
+26 WRITE "Changing the TCP port from ",$PIECE(X,U,2)," to ",$PIECE(Y,U,2),!
HANG 2
+27 SET $PIECE(X,U,2)=$PIECE(Y,U,2)
End DoDot:1
+28 IF '$TEST
IF $PIECE(X,U,2)=""
Begin DoDot:1
+29 WRITE "Setting the TCP port to ",$PIECE(Y,U,2),!
HANG 2
+30 SET $PIECE(X,U,2)=$PIECE(Y,U,2)
End DoDot:1
+31 SET ^ABSP(9002313.55,T1,"SERVER")=X
+32 WRITE !,"Settings for ",$$T1NAME," have been updated.",!
HANG 2
+33 WRITE !
+34 WRITE "If you customized any dial outs to also point to the T1 address",!
+35 WRITE "and port, you will need to update those manually using the",!
HANG 1
+36 WRITE "MGR/SET/DIAL menu to set up the dial outs.",!
HANG 2
+37 QUIT
T1VALUES ;199.244.222.6^6802
CLOVERLF ;161.223.90.56^5006
T1() QUIT $ORDER(^ABSP(9002313.55,"B",$$T1NAME,0))
T1NAME() QUIT "ENVOY DIRECT VIA T1 LINE"
ANMC ; Special for ANMC
+1 ; Rename the receipt protocol
+2 ; Lookup the ABSP P1 RECEIPT protocol
+3 ; and change its ITEM TEXT (#1) to "Print DUR data"
+4 WRITE !,"Renaming the ABSP P1 RECEIPT protocol's ITEM TEXT...",!
+5 NEW PRO
SET PRO=$$FIND1^DIC(101,,,"ABSP P1 RECEIPT")
+6 IF 'PRO
WRITE "Could not find it!",!
QUIT
+7 SET PRO=PRO_","
+8 NEW FDA,MSG
SET FDA(101,PRO,1)="Print DUR data"
+9 DO FILE^DIE(,"FDA","MSG")
+10 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("ANMC+10^ABSPOSZ",.MSG)
+11 IF $DATA(MSG)
WRITE "Error in FILE^DIE: ",!
DO ZWRITE^ABSPOS("MSG")
QUIT
+12 WRITE "Done",!
+13 ;
+14 ; File 101, Subfile 101.01, Field .01
+15 ; Lookup which one points to ABSP P1 RECEIPT
+16 ; and change its Mnemonic (#2) to "DUR"
+17 ;
+18 WRITE "Finding the menu in ABSP PROTOCOL 1...",!
+19 NEW PRO1
+20 ; top-level protocol
SET PRO=$$FIND1^DIC(101,,,"ABSP PROTOCOL 1")
+21 IF 'PRO
WRITE "Could not find it!",!
QUIT
+22 SET PRO=PRO_","
+23 WRITE "Finding the ABSP P1 RECEIPT among the ITEMs therein...",!
+24 SET PRO1=$$FIND1^DIC(101.01,","_PRO,,"ABSP P1 RECEIPT")
+25 IF 'PRO1
WRITE "Could not find it!",!
QUIT
+26 KILL FDA,MSG
SET FDA(101.01,PRO1_","_PRO,2)="DUR"
+27 DO FILE^DIE(,"FDA","MSG")
+28 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("ANMC+28^ABSPOSZ",.MSG)
+29 IF $DATA(MSG)
WRITE "Error in FILE^DIE: ",!
DO ZWRITE^ABSPOS("MSG")
QUIT
+30 WRITE "Done",!
+31 QUIT
HASILCAR() ; does the site have ILC A/R installed and active?
+1 ; This is for use only by installation procedure!
+2 ; Look at the most recently created bill. See if it was in the
+3 ; past week or so.
+4 NEW PCN
SET PCN=$PIECE($GET(^ABSBITMS(9002302,0)),U,3)
+5 IF 'PCN
QUIT 0
+6 ; date created
NEW X1,X2,X,%Y
SET X2=$PIECE($GET(^ABSBITMS(9002302,PCN,4)),U)
+7 ; impossible
IF 'X2
QUIT 0
+8 SET X1=DT
DO ^%DTC
+9 QUIT X<9
+1 ; change the ITEM named ABSP BILLING MENU
+2 ; to ABSP BILLING MENU FOR ILC A/R
+3 WRITE !,"ILC A/R detected!",!
+4 WRITE !,"As a result, we now make a change to the correct billing menu.",!
+5 NEW MAINMENU
SET MAINMENU=$$FIND1^DIC(19,,"X","ABSPMENU")
+6 IF 'MAINMENU
WRITE !!?10,"Couldn't find ABSPMENU in file 19??",!
QUIT
+7 NEW BILLMENU
+8 SET BILLMENU=$$FIND1^DIC(19.01,","_MAINMENU_",","X","ABSP BILLING MENU")
+9 IF 'BILLMENU
WRITE !!?10,"Couldn't find ABSP BILLING MENU in ABSPMENU??",!
QUIT
+10 NEW FDA,MSG
SET FDA(19.01,BILLMENU_","_MAINMENU_",",.01)="ABSP BILLING MENU FOR ILC A/R"
+11 DO FILE^DIE("E","FDA","MSG")
+12 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("BILLMENU^ABSPOSZ",.MSG)
+13 IF $DATA(MSG)
Begin DoDot:1
+14 WRITE !!?10,"Failed to change the BILLING MENU item",!
+15 DO ZWRITE^ABSPOS("FDA","MSG")
End DoDot:1
+16 QUIT
INIT58 ; Make sure there's an entry in file 9002313.58
+1 ; already is one
IF $PIECE(^ABSPECX("S",0),U,3)
QUIT
+2 NEW FDA,MSG
+3 SET FDA(9002313.58,"+1,",.01)=1
+4 DO UPDATE^DIE(,"FDA",,"MSG")
+5 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("INIT58^ABSPOSZ",.MSG)
+6 QUIT
