- 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 Feb 18, 2025@23:25:16 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