GMTSP37 ; CIO/SLC - Post Install GMTS*2.7*37 ; 07/18/2000
;;2.7;Health Summary;**37**;Oct 20, 1995
;
Q
POST ; Post Install
D BM(" Setting up CPT Modifiers in Health Summary Components"),BL K ^TMP("GMTSP37")
N GMTSABR F GMTSABR="RP","OE","SR","SRO","NSR","SNSR" D COM,TYP K ^TMP("GMTSP37")
MSG N GMTSBLD,GMTSINST,GMTSHORT I +$$ROK("GMTSXPS1")>0 S GMTSHORT="",GMTSINST="",GMTSBLD="GMTS*2.7*37" D SEND^GMTSXPS1
Q
COM ; Update Health Summary Components
Q:'$L($G(GMTSABR)) N GMTSCI,GMTSCNM,GMTST,GMTSTI,GMTSSI
S GMTSCI=+($O(^GMT(142.1,"C",GMTSABR,0))) Q:GMTSCI=0 S GMTSCNM=$P($G(^GMT(142.1,+GMTSCI,0)),"^",9) S:'$L(GMTSCNM) GMTSCNM=$P($G(^GMT(142.1,+GMTSCI,0)),"^") Q:'$L(GMTSCNM) S GMTST=GMTSCNM F Q:$L(GMTST)>22 S GMTST=GMTST_" "
S GMTST=" "_GMTST_" "_GMTSABR D M(GMTST),EDC S GMTSTI=0 F S GMTSTI=$O(^GMT(142,"AE",GMTSCI,GMTSTI)) Q:+GMTSTI=0 S GMTSSI=0 F S GMTSSI=$O(^GMT(142,"AE",GMTSCI,GMTSTI,GMTSSI)) Q:+GMTSSI=0 S ^TMP("GMTSP37",GMTSTI,GMTSSI,GMTSCI)=""
Q
EDC ; Edit Component
N X,Y,DIC,DIE,DTOUT,DA S DA=+($G(GMTSCI)) Q:DA=0 Q:'$D(^GMT(142.1,DA,0))
S (DIC,DIE)="^GMT(142.1,",DR="14///Y"
; DBIA 10018 call ^DIE
D ^DIE
Q
TYP ; Update Health Summary Types
N GMTSTI,GMTSTN,GMTSSI,GMTSCI,GMTSCN,GMTST,GMTSC,GMTSCT S (GMTSC,GMTSCT,GMTSTI)=0 F S GMTSTI=$O(^TMP("GMTSP37",GMTSTI)) Q:+GMTSTI=0 D
. S (GMTSCT,GMTSSI)=0 F S GMTSSI=$O(^TMP("GMTSP37",GMTSTI,GMTSSI)) Q:+GMTSSI=0 D
. . S GMTSCT=GMTSCT+1,GMTSCI=0 F S GMTSCI=$O(^TMP("GMTSP37",GMTSTI,GMTSSI,GMTSCI)) Q:+GMTSCI=0 D
. . . S GMTSTN=$P($G(^GMT(142,GMTSTI,0)),"^",1),GMTSC=GMTSC+1 D:GMTSC=1 BM(" Setting up CPT Modifiers in Health Summary Types"),BL S GMTST=" "_GMTSTN_" " D:GMTSCT=1 M(GMTST) D EDT
Q
EDT ; Edit Type
N X,Y,DIC,DIE,DTOUT,DA Q:+($G(GMTSTI))=0 Q:+($G(GMTSSI))=0 S DA(1)=+($G(GMTSTI)),DA=+($G(GMTSSI)),(DIC,DIE)="^GMT(142,"_DA(1)_",1,",DR="9///Y" D ^DIE
Q
BM(X) ; Blank Line with Message
Q:$D(GMTSQT)
; DBIA 10141 call BMES^XPDUTL
D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
BL ; Blank Line with w/o Message
Q:$D(GMTSQT)
; DBIA 10141 call MES^XPDUTL
D:$D(XPDNM) MES^XPDUTL(" ") W:'$D(XPDNM) !," " Q
M(X) ; Message
Q:$D(GMTSQT)
; DBIA 10141 call MES^XPDUTL
D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
ROK(X) ; Routine OK
S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0
; DBIA 10096 access ^%ZOSF
X ^%ZOSF("TEST")
Q:$T 1 Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSP37 2404 printed Dec 13, 2024@01:58:55 Page 2
GMTSP37 ; CIO/SLC - Post Install GMTS*2.7*37 ; 07/18/2000
+1 ;;2.7;Health Summary;**37**;Oct 20, 1995
+2 ;
+3 QUIT
POST ; Post Install
+1 DO BM(" Setting up CPT Modifiers in Health Summary Components")
DO BL
KILL ^TMP("GMTSP37")
+2 NEW GMTSABR
FOR GMTSABR="RP","OE","SR","SRO","NSR","SNSR"
DO COM
DO TYP
KILL ^TMP("GMTSP37")
MSG NEW GMTSBLD,GMTSINST,GMTSHORT
IF +$$ROK("GMTSXPS1")>0
SET GMTSHORT=""
SET GMTSINST=""
SET GMTSBLD="GMTS*2.7*37"
DO SEND^GMTSXPS1
+1 QUIT
COM ; Update Health Summary Components
+1 if '$LENGTH($GET(GMTSABR))
QUIT
NEW GMTSCI,GMTSCNM,GMTST,GMTSTI,GMTSSI
+2 SET GMTSCI=+($ORDER(^GMT(142.1,"C",GMTSABR,0)))
if GMTSCI=0
QUIT
SET GMTSCNM=$PIECE($GET(^GMT(142.1,+GMTSCI,0)),"^",9)
if '$LENGTH(GMTSCNM)
SET GMTSCNM=$PIECE($GET(^GMT(142.1,+GMTSCI,0)),"^")
if '$LENGTH(GMTSCNM)
QUIT
SET GMTST=GMTSCNM
FOR
if $LENGTH(GMTST)>22
QUIT
SET GMTST=GMTST_" "
+3 SET GMTST=" "_GMTST_" "_GMTSABR
DO M(GMTST)
DO EDC
SET GMTSTI=0
FOR
SET GMTSTI=$ORDER(^GMT(142,"AE",GMTSCI,GMTSTI))
if +GMTSTI=0
QUIT
SET GMTSSI=0
FOR
SET GMTSSI=$ORDER(^GMT(142,"AE",GMTSCI,GMTSTI,GMTSSI))
if +GMTSSI=0
QUIT
SET ^TMP("GMTSP37",GMTSTI,GMTSSI,GMTSCI)=""
+4 QUIT
EDC ; Edit Component
+1 NEW X,Y,DIC,DIE,DTOUT,DA
SET DA=+($GET(GMTSCI))
if DA=0
QUIT
if '$DATA(^GMT(142.1,DA,0))
QUIT
+2 SET (DIC,DIE)="^GMT(142.1,"
SET DR="14///Y"
+3 ; DBIA 10018 call ^DIE
+4 DO ^DIE
+5 QUIT
TYP ; Update Health Summary Types
+1 NEW GMTSTI,GMTSTN,GMTSSI,GMTSCI,GMTSCN,GMTST,GMTSC,GMTSCT
SET (GMTSC,GMTSCT,GMTSTI)=0
FOR
SET GMTSTI=$ORDER(^TMP("GMTSP37",GMTSTI))
if +GMTSTI=0
QUIT
Begin DoDot:1
+2 SET (GMTSCT,GMTSSI)=0
FOR
SET GMTSSI=$ORDER(^TMP("GMTSP37",GMTSTI,GMTSSI))
if +GMTSSI=0
QUIT
Begin DoDot:2
+3 SET GMTSCT=GMTSCT+1
SET GMTSCI=0
FOR
SET GMTSCI=$ORDER(^TMP("GMTSP37",GMTSTI,GMTSSI,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:3
+4 SET GMTSTN=$PIECE($GET(^GMT(142,GMTSTI,0)),"^",1)
SET GMTSC=GMTSC+1
if GMTSC=1
DO BM(" Setting up CPT Modifiers in Health Summary Types")
DO BL
SET GMTST=" "_GMTSTN_" "
if GMTSCT=1
DO M(GMTST)
DO EDT
End DoDot:3
End DoDot:2
End DoDot:1
+5 QUIT
EDT ; Edit Type
+1 NEW X,Y,DIC,DIE,DTOUT,DA
if +($GET(GMTSTI))=0
QUIT
if +($GET(GMTSSI))=0
QUIT
SET DA(1)=+($GET(GMTSTI))
SET DA=+($GET(GMTSSI))
SET (DIC,DIE)="^GMT(142,"_DA(1)_",1,"
SET DR="9///Y"
DO ^DIE
+2 QUIT
BM(X) ; Blank Line with Message
+1 if $DATA(GMTSQT)
QUIT
+2 ; DBIA 10141 call BMES^XPDUTL
+3 if $DATA(XPDNM)
DO BMES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !!,$GET(X)
QUIT
BL ; Blank Line with w/o Message
+1 if $DATA(GMTSQT)
QUIT
+2 ; DBIA 10141 call MES^XPDUTL
+3 if $DATA(XPDNM)
DO MES^XPDUTL(" ")
if '$DATA(XPDNM)
WRITE !," "
QUIT
M(X) ; Message
+1 if $DATA(GMTSQT)
QUIT
+2 ; DBIA 10141 call MES^XPDUTL
+3 if $DATA(XPDNM)
DO MES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !,$GET(X)
QUIT
ROK(X) ; Routine OK
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT 0
if $LENGTH(X)>8
QUIT 0
+2 ; DBIA 10096 access ^%ZOSF
+3 XECUTE ^%ZOSF("TEST")
+4 if $TEST
QUIT 1
QUIT 0
