GMTSP134 ;ISP/LMT - HEALTH SUMMARY Patch 134 Env Check and Post-Install ;Mar 09, 2020@12:01
;;2.7;Health Summary;**134**;Oct 20, 1995;Build 25
;
;
ENV ;
;check for and warn installer about duplicate Names or Abbreviations between local system and incoming national components (142.1)
D INFO,CONT
N GMTSITEM,GMTSINC,GMTSFLG,GMTSCONT,GMTSIEN S (GMTSITEM,GMTSINC)="",(GMTSFLG,GMTSCONT,GMTSIEN)=0
F GMTSINC=1:1 S GMTSITEM=$P($T(ABV+GMTSINC),";",3),GMTSIEN=$P(GMTSITEM,U,2),GMTSITEM=$P(GMTSITEM,U) Q:GMTSITEM="EOF" D
.Q:$D(^GMT(142.1,"C",GMTSITEM))&(GMTSIEN=+$O(^GMT(142.1,"C",GMTSITEM,""))) ;for test sites & multiple installs
.I $D(^GMT(142.1,"C",GMTSITEM)) D ;report conflict if abbreviation found
.. W !,"CONFLICT: "_GMTSITEM_" is an existing ABBREVIATION for IEN "_+$O(^GMT(142.1,"C",GMTSITEM,""))
..S GMTSFLG=1
S (GMTSITEM,GMTSINC)="",GMTSCONT=0
F GMTSINC=1:1 S GMTSITEM=$P($T(NAME+GMTSINC),";",3),GMTSIEN=$P(GMTSITEM,U,2),GMTSITEM=$P(GMTSITEM,U) Q:GMTSITEM="EOF" D
.Q:$D(^GMT(142.1,"B",GMTSITEM))&(GMTSIEN=+$O(^GMT(142.1,"B",GMTSITEM,""))) ;for test sites & multiple installs
.I $D(^GMT(142.1,"B",GMTSITEM)) D ;report conflict if name found
..W !,"CONFLICT: "_GMTSITEM_" is an existing NAME for IEN "_+$O(^GMT(142.1,"B",GMTSITEM,""))
..S GMTSFLG=1
S:GMTSFLG GMTSCONT=$$OW
W:$G(GMTSCONT)=1 !,"OK - Install will continue"
I GMTSFLG=0,GMTSCONT=0 D
.W !,"Environment check complete. No conflicts found."
Q
INFO ; info
W !,"New Health Summary Component (#142.1) entries will be installed by this"
W !,"patch. NAME (.01) and ABBREVIATION (4) values should be unique throughout"
W !,"this file. Any conflicts found will be written to the screen and you will"
W !,"have the choice to continue with installation or abort. Conflicts do not"
W !,"prevent you from installing, but should be addressed soon after install.",!
Q
CONT() ; -- read output before continuing
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="FO",DIR("A")="<Enter> to continue"
D ^DIR
Q
OW() ;ASK THE USER TO CONTINUE WITH INSTALLATION
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
W !!,"Installation *may* continue, but you must record these conflicts and"
W !,"pass along to the appropriate site resource for review and edit of"
W !,"local/existing items.",!
S DIR(0)="Y^",DIR("A")="Do you wish to proceed with installation of this patch",DIR("B")="NO"
D ^DIR
W !
S:+$G(Y)=0 XPDQUIT=2
Q:$G(XPDQUIT)=2 +$G(Y)
Q +$G(Y)
ABV ;abbreviations
;;PMPA^271
;;EOF
NAME ;names
;;PDMP AOD ALL^271
;;EOF
;
;
POST ; Post-Install
D CI
Q
;
;
CI ; Component Install
N GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI
N INCLUDE
S GMTSCPS="PMPA"
F GMTSCI=1:1 Q:'$L($P(GMTSCPS,";",GMTSCI)) D
. S GMTSCP=$P(GMTSCPS,";",GMTSCI) K GMTSIN
. D ARRAY Q:'$D(GMTSIN)
. I $L($G(GMTSIN("TIM"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"TIM")=$G(GMTSIN("TIM"))
. I $L($G(GMTSIN("OCC"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"OCC")=$G(GMTSIN("OCC"))
. S GMTSINST=$$ADD^GMTSXPD1(.GMTSIN),GMTSTOT=+($G(GMTSTOT))+($G(GMTSINST))
; Rebuild Ad Hoc Health Summary Type
I $G(GMTSTOT)>0 S INCLUDE=+$G(XPDQUES("POS1")) D ENPOST^GMTSLOAD
D LIM
I $L($T(SEND^GMTSXPS1)) D
. N GMTSHORT S GMTSHORT=1,GMTSINST="",GMTSBLD="GMTS*2.7*134" D SEND^GMTSXPS1
Q
ARRAY ; Build Array
K GMTSIN N GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX S GMTSPDX=1,GMTSCP=$G(GMTSCP) Q:'$L(GMTSCP)
F GMTSI=1:1 D Q:'$L(GMTSTXT)
. S GMTSTXT="",GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")" X GMTSEX S:$L(GMTSTXT,";")'>3 GMTSTXT="" Q:'$L(GMTSTXT)
. S GMTSFLD=$P(GMTSTXT,";",2),GMTSUB=$P(GMTSTXT,";",3),GMTSVAL=$P(GMTSTXT,";",4)
. S:$E(GMTSFLD,1)=1&(+GMTSFLD<2) GMTSVAL=$P(GMTSTXT,";",4,5)
. S:$E(GMTSFLD,1)=" "!('$L(GMTSFLD)) GMTSTXT="" Q:GMTSTXT=""
. S:$L(GMTSFLD)&('$L(GMTSUB)) GMTSIN(GMTSFLD)=GMTSVAL Q:$L(GMTSFLD)&('$L(GMTSUB))
. S:$L(GMTSFLD)&($L(GMTSUB)) GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
. S:$G(GMTSFLD)=7&(+($G(GMTSUB))>0) GMTSPDX=0
K:+($G(GMTSPDX))=0 GMTSIN("PDX")
Q
LIM ; Limits
N GMTSI,GMTST,GMTSO,GMTSA S GMTSI=0 F S GMTSI=$O(GMTSLIM(GMTSI)) Q:+GMTSI=0 D
. S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",3),GMTST=$G(GMTSLIM(+GMTSI,"TIM")) S:'$L(GMTST) GMTST=$S(GMTSA="Y ":"1Y ",1:"")
. S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",5),GMTSO=$G(GMTSLIM(+GMTSI,"OCC")) S:'$L(GMTSO) GMTSO=$S(GMTSA="Y ":"10 ",1:"")
. D TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
Q
;
PMPA ; PDMP AoD All Component Data
;0;;271
;.01;;PDMP AOD ALL
;1;;PDMPAODA;GMTSORPD
;1.1;;0
;2;;Y
;3;;PMPA
;3.5;;9
;3.5;1;This component lists the PDMP Accounting of Disclosures for instances
;3.5;2;where a PDMP query was initiated from within CPRS and patient's data was
;3.5;3;shared outside of the VA. It will also include cases where a PDMP
;3.5;4;note was manually created to document a PDMP query made directly on a
;3.5;5;state's PDMP portal.
;4;;
;5;;
;6;;
;7;;0
;8;;
;9;;PDMP AoD All
;10;;
;11;;
;12;;
;13;;
;14;;
;PDX;;1
;TIM;;1Y
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSP134 5077 printed Nov 22, 2024@17:08:54 Page 2
GMTSP134 ;ISP/LMT - HEALTH SUMMARY Patch 134 Env Check and Post-Install ;Mar 09, 2020@12:01
+1 ;;2.7;Health Summary;**134**;Oct 20, 1995;Build 25
+2 ;
+3 ;
ENV ;
+1 ;check for and warn installer about duplicate Names or Abbreviations between local system and incoming national components (142.1)
+2 DO INFO
DO CONT
+3 NEW GMTSITEM,GMTSINC,GMTSFLG,GMTSCONT,GMTSIEN
SET (GMTSITEM,GMTSINC)=""
SET (GMTSFLG,GMTSCONT,GMTSIEN)=0
+4 FOR GMTSINC=1:1
SET GMTSITEM=$PIECE($TEXT(ABV+GMTSINC),";",3)
SET GMTSIEN=$PIECE(GMTSITEM,U,2)
SET GMTSITEM=$PIECE(GMTSITEM,U)
if GMTSITEM="EOF"
QUIT
Begin DoDot:1
+5 ;for test sites & multiple installs
if $DATA(^GMT(142.1,"C",GMTSITEM))&(GMTSIEN=+$ORDER(^GMT(142.1,"C",GMTSITEM,"")))
QUIT
+6 ;report conflict if abbreviation found
IF $DATA(^GMT(142.1,"C",GMTSITEM))
Begin DoDot:2
+7 WRITE !,"CONFLICT: "_GMTSITEM_" is an existing ABBREVIATION for IEN "_+$ORDER(^GMT(142.1,"C",GMTSITEM,""))
+8 SET GMTSFLG=1
End DoDot:2
End DoDot:1
+9 SET (GMTSITEM,GMTSINC)=""
SET GMTSCONT=0
+10 FOR GMTSINC=1:1
SET GMTSITEM=$PIECE($TEXT(NAME+GMTSINC),";",3)
SET GMTSIEN=$PIECE(GMTSITEM,U,2)
SET GMTSITEM=$PIECE(GMTSITEM,U)
if GMTSITEM="EOF"
QUIT
Begin DoDot:1
+11 ;for test sites & multiple installs
if $DATA(^GMT(142.1,"B",GMTSITEM))&(GMTSIEN=+$ORDER(^GMT(142.1,"B",GMTSITEM,"")))
QUIT
+12 ;report conflict if name found
IF $DATA(^GMT(142.1,"B",GMTSITEM))
Begin DoDot:2
+13 WRITE !,"CONFLICT: "_GMTSITEM_" is an existing NAME for IEN "_+$ORDER(^GMT(142.1,"B",GMTSITEM,""))
+14 SET GMTSFLG=1
End DoDot:2
End DoDot:1
+15 if GMTSFLG
SET GMTSCONT=$$OW
+16 if $GET(GMTSCONT)=1
WRITE !,"OK - Install will continue"
+17 IF GMTSFLG=0
IF GMTSCONT=0
Begin DoDot:1
+18 WRITE !,"Environment check complete. No conflicts found."
End DoDot:1
+19 QUIT
INFO ; info
+1 WRITE !,"New Health Summary Component (#142.1) entries will be installed by this"
+2 WRITE !,"patch. NAME (.01) and ABBREVIATION (4) values should be unique throughout"
+3 WRITE !,"this file. Any conflicts found will be written to the screen and you will"
+4 WRITE !,"have the choice to continue with installation or abort. Conflicts do not"
+5 WRITE !,"prevent you from installing, but should be addressed soon after install.",!
+6 QUIT
CONT() ; -- read output before continuing
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="FO"
SET DIR("A")="<Enter> to continue"
+3 DO ^DIR
+4 QUIT
OW() ;ASK THE USER TO CONTINUE WITH INSTALLATION
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 WRITE !!,"Installation *may* continue, but you must record these conflicts and"
+3 WRITE !,"pass along to the appropriate site resource for review and edit of"
+4 WRITE !,"local/existing items.",!
+5 SET DIR(0)="Y^"
SET DIR("A")="Do you wish to proceed with installation of this patch"
SET DIR("B")="NO"
+6 DO ^DIR
+7 WRITE !
+8 if +$GET(Y)=0
SET XPDQUIT=2
+9 if $GET(XPDQUIT)=2
QUIT +$GET(Y)
+10 QUIT +$GET(Y)
ABV ;abbreviations
+1 ;;PMPA^271
+2 ;;EOF
NAME ;names
+1 ;;PDMP AOD ALL^271
+2 ;;EOF
+3 ;
+4 ;
POST ; Post-Install
+1 DO CI
+2 QUIT
+3 ;
+4 ;
CI ; Component Install
+1 NEW GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI
+2 NEW INCLUDE
+3 SET GMTSCPS="PMPA"
+4 FOR GMTSCI=1:1
if '$LENGTH($PIECE(GMTSCPS,";",GMTSCI))
QUIT
Begin DoDot:1
+5 SET GMTSCP=$PIECE(GMTSCPS,";",GMTSCI)
KILL GMTSIN
+6 DO ARRAY
if '$DATA(GMTSIN)
QUIT
+7 IF $LENGTH($GET(GMTSIN("TIM")))
IF +($GET(GMTSIN(0)))>0
SET GMTSLIM(+($GET(GMTSIN(0))),"TIM")=$GET(GMTSIN("TIM"))
+8 IF $LENGTH($GET(GMTSIN("OCC")))
IF +($GET(GMTSIN(0)))>0
SET GMTSLIM(+($GET(GMTSIN(0))),"OCC")=$GET(GMTSIN("OCC"))
+9 SET GMTSINST=$$ADD^GMTSXPD1(.GMTSIN)
SET GMTSTOT=+($GET(GMTSTOT))+($GET(GMTSINST))
End DoDot:1
+10 ; Rebuild Ad Hoc Health Summary Type
+11 IF $GET(GMTSTOT)>0
SET INCLUDE=+$GET(XPDQUES("POS1"))
DO ENPOST^GMTSLOAD
+12 DO LIM
+13 IF $LENGTH($TEXT(SEND^GMTSXPS1))
Begin DoDot:1
+14 NEW GMTSHORT
SET GMTSHORT=1
SET GMTSINST=""
SET GMTSBLD="GMTS*2.7*134"
DO SEND^GMTSXPS1
End DoDot:1
+15 QUIT
ARRAY ; Build Array
+1 KILL GMTSIN
NEW GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX
SET GMTSPDX=1
SET GMTSCP=$GET(GMTSCP)
if '$LENGTH(GMTSCP)
QUIT
+2 FOR GMTSI=1:1
Begin DoDot:1
+3 SET GMTSTXT=""
SET GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")"
XECUTE GMTSEX
if $LENGTH(GMTSTXT,";")'>3
SET GMTSTXT=""
if '$LENGTH(GMTSTXT)
QUIT
+4 SET GMTSFLD=$PIECE(GMTSTXT,";",2)
SET GMTSUB=$PIECE(GMTSTXT,";",3)
SET GMTSVAL=$PIECE(GMTSTXT,";",4)
+5 if $EXTRACT(GMTSFLD,1)=1&(+GMTSFLD<2)
SET GMTSVAL=$PIECE(GMTSTXT,";",4,5)
+6 if $EXTRACT(GMTSFLD,1)=" "!('$LENGTH(GMTSFLD))
SET GMTSTXT=""
if GMTSTXT=""
QUIT
+7 if $LENGTH(GMTSFLD)&('$LENGTH(GMTSUB))
SET GMTSIN(GMTSFLD)=GMTSVAL
if $LENGTH(GMTSFLD)&('$LENGTH(GMTSUB))
QUIT
+8 if $LENGTH(GMTSFLD)&($LENGTH(GMTSUB))
SET GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
+9 if $GET(GMTSFLD)=7&(+($GET(GMTSUB))>0)
SET GMTSPDX=0
End DoDot:1
if '$LENGTH(GMTSTXT)
QUIT
+10 if +($GET(GMTSPDX))=0
KILL GMTSIN("PDX")
+11 QUIT
LIM ; Limits
+1 NEW GMTSI,GMTST,GMTSO,GMTSA
SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSLIM(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+2 SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(GMTSI)),0)),"^",3)
SET GMTST=$GET(GMTSLIM(+GMTSI,"TIM"))
if '$LENGTH(GMTST)
SET GMTST=$SELECT(GMTSA="Y ":"1Y ",1:"")
+3 SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(GMTSI)),0)),"^",5)
SET GMTSO=$GET(GMTSLIM(+GMTSI,"OCC"))
if '$LENGTH(GMTSO)
SET GMTSO=$SELECT(GMTSA="Y ":"10 ",1:"")
+4 DO TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
End DoDot:1
+5 QUIT
+6 ;
PMPA ; PDMP AoD All Component Data
+1 ;0;;271
+2 ;.01;;PDMP AOD ALL
+3 ;1;;PDMPAODA;GMTSORPD
+4 ;1.1;;0
+5 ;2;;Y
+6 ;3;;PMPA
+7 ;3.5;;9
+8 ;3.5;1;This component lists the PDMP Accounting of Disclosures for instances
+9 ;3.5;2;where a PDMP query was initiated from within CPRS and patient's data was
+10 ;3.5;3;shared outside of the VA. It will also include cases where a PDMP
+11 ;3.5;4;note was manually created to document a PDMP query made directly on a
+12 ;3.5;5;state's PDMP portal.
+13 ;4;;
+14 ;5;;
+15 ;6;;
+16 ;7;;0
+17 ;8;;
+18 ;9;;PDMP AoD All
+19 ;10;;
+20 ;11;;
+21 ;12;;
+22 ;13;;
+23 ;14;;
+24 ;PDX;;1
+25 ;TIM;;1Y
+26 ;
+27 QUIT
+28 ;
