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

ABSPOSZ.m

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