GMTSPNB ; SLC/JER/KER - TIU Brief Progress Notes ; 04/30/2002
;;2.7;Health Summary;**12,28,33,49,55**;Oct 20, 1995
;
; External References
; DBIA 10006 ^DIC (file #8925.1)
; DBIA 10011 ^DIWP
; DBIA 2902 VISIT^TIULAPIC
; DBIA 2902 MAIN^TIULAPIC
;
MAIN ; Controls branching and execution
N PN,GMTSI,GMTSJ,TIUFPRIV,TIUSTAT,TIUTYPE,X,DIWF,DIWL,DIWR,MAX
K ^TMP("TIU",$J) S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
S TIUSTAT="COMPLETED",TIUFPRIV=1
N X,Y S X="PROGRESS NOTES",DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""CL""" D ^DIC S:Y>0 TIUTYPE=+Y
D EXTIU(DFN,TIUTYPE,GMTS1,GMTS2,MAX,0) Q:'$D(^TMP("TIU",$J))
D HEADER S GMTSI=0 F S GMTSI=$O(^TMP("TIU",$J,GMTSI)) Q:+GMTSI'>0!$D(GMTSQIT) D
. S GMTSJ=0 F S GMTSJ=$O(^TMP("TIU",$J,GMTSI,GMTSJ)) Q:+GMTSJ'>0!$D(GMTSQIT) D
. . D VARI(GMTSI,GMTSJ)
. . I $D(^TMP("TIU",$J,GMTSI,GMTSJ,"ZADD")) D ADDEND(GMTSI,GMTSJ)
. . D WRT
K ^TMP("TIU",$J)
Q
;
D CKP^GMTSUP Q:$D(GMTSQIT) W "Prog Note DT",?16,"Title",?48,"Author",?64,"Last Corr DT",!!
Q
;
VARI(GMTSI,GMTSJ) ;Sets variables for display
S GMTSCNT=+$G(GMTSCNT)+1
S X=$G(^TMP("TIU",$J,GMTSI,GMTSJ,1301,"I")) D REGDT4^GMTSU S PN("DATE")=X
S PN("AUTHOR")=$G(^TMP("TIU",$J,GMTSI,GMTSJ,1202,"E"))
S PN("DOCTYPE")=$G(^TMP("TIU",$J,GMTSI,GMTSJ,.01,"E"))
I $L(PN("DOCTYPE"))>30 D FORMAT S PN("DOCTYPE")=^UTILITY($J,"W",1,1,0)
S PN("CORRDT")=""
Q
;
ADDEND(GMTSI,GMTSJ) ;Addenda date display
N GMTSAD
S GMTSAD=0
S GMTSAD=$O(^TMP("TIU",$J,GMTSI,GMTSJ,"ZADD",GMTSAD)) Q:+GMTSAD'>0
S X=^TMP("TIU",$J,GMTSI,GMTSJ,"ZADD",GMTSAD,1301,"I")
D REGDT4^GMTSU S PN("CORRDT")=X
Q
;
WRT ; Writes the component data
D CKP^GMTSUP Q:$D(GMTSQIT)
D:GMTSNPG HEADER W PN("DATE"),?16,PN("DOCTYPE"),?48,PN("AUTHOR"),?64,PN("CORRDT"),!
I $D(^UTILITY($J,"W",1,2,0)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?16,^UTILITY($J,"W",1,2,0),!
K PN,^UTILITY($J)
Q
;
FORMAT ; Calls ^DIWP to format Title
N DIWF,DIWL,DIWR,X
S DIWF="C30",DIWL=1,DIWR=30,X=PN("DOCTYPE") D ^DIWP
Q
EXTIU(DFN,GMTST,GMTS1,GMTS2,GMTSN,GMTSX) ; Extract Patient/Visit VIA TIU
N GMTSPV S GMTSPV=+($G(GMTSPXGO)) I GMTSPV,$L($T(VISIT^TIULAPIC)) D VISIT^TIULAPIC($G(DFN),$G(GMTST),$G(GMTS1),$G(GMTS2),$G(GMTSN),$G(GMTSX)) Q
D MAIN^TIULAPIC($G(DFN),$G(GMTST),$G(GMTS1),$G(GMTS2),$G(GMTSN),$G(GMTSX))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPNB 2430 printed Dec 13, 2024@01:59:22 Page 2
GMTSPNB ; SLC/JER/KER - TIU Brief Progress Notes ; 04/30/2002
+1 ;;2.7;Health Summary;**12,28,33,49,55**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10006 ^DIC (file #8925.1)
+5 ; DBIA 10011 ^DIWP
+6 ; DBIA 2902 VISIT^TIULAPIC
+7 ; DBIA 2902 MAIN^TIULAPIC
+8 ;
MAIN ; Controls branching and execution
+1 NEW PN,GMTSI,GMTSJ,TIUFPRIV,TIUSTAT,TIUTYPE,X,DIWF,DIWL,DIWR,MAX
+2 KILL ^TMP("TIU",$JOB)
SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+3 SET TIUSTAT="COMPLETED"
SET TIUFPRIV=1
+4 NEW X,Y
SET X="PROGRESS NOTES"
SET DIC="^TIU(8925.1,"
SET DIC(0)="X"
SET DIC("S")="I $P($G(^(0)),U,4)=""CL"""
DO ^DIC
if Y>0
SET TIUTYPE=+Y
+5 DO EXTIU(DFN,TIUTYPE,GMTS1,GMTS2,MAX,0)
if '$DATA(^TMP("TIU",$JOB))
QUIT
+6 DO HEADER
SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP("TIU",$JOB,GMTSI))
if +GMTSI'>0!$DATA(GMTSQIT)
QUIT
Begin DoDot:1
+7 SET GMTSJ=0
FOR
SET GMTSJ=$ORDER(^TMP("TIU",$JOB,GMTSI,GMTSJ))
if +GMTSJ'>0!$DATA(GMTSQIT)
QUIT
Begin DoDot:2
+8 DO VARI(GMTSI,GMTSJ)
+9 IF $DATA(^TMP("TIU",$JOB,GMTSI,GMTSJ,"ZADD"))
DO ADDEND(GMTSI,GMTSJ)
+10 DO WRT
End DoDot:2
End DoDot:1
+11 KILL ^TMP("TIU",$JOB)
+12 QUIT
+13 ;
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Prog Note DT",?16,"Title",?48,"Author",?64,"Last Corr DT",!!
+2 QUIT
+3 ;
VARI(GMTSI,GMTSJ) ;Sets variables for display
+1 SET GMTSCNT=+$GET(GMTSCNT)+1
+2 SET X=$GET(^TMP("TIU",$JOB,GMTSI,GMTSJ,1301,"I"))
DO REGDT4^GMTSU
SET PN("DATE")=X
+3 SET PN("AUTHOR")=$GET(^TMP("TIU",$JOB,GMTSI,GMTSJ,1202,"E"))
+4 SET PN("DOCTYPE")=$GET(^TMP("TIU",$JOB,GMTSI,GMTSJ,.01,"E"))
+5 IF $LENGTH(PN("DOCTYPE"))>30
DO FORMAT
SET PN("DOCTYPE")=^UTILITY($JOB,"W",1,1,0)
+6 SET PN("CORRDT")=""
+7 QUIT
+8 ;
ADDEND(GMTSI,GMTSJ) ;Addenda date display
+1 NEW GMTSAD
+2 SET GMTSAD=0
+3 SET GMTSAD=$ORDER(^TMP("TIU",$JOB,GMTSI,GMTSJ,"ZADD",GMTSAD))
if +GMTSAD'>0
QUIT
+4 SET X=^TMP("TIU",$JOB,GMTSI,GMTSJ,"ZADD",GMTSAD,1301,"I")
+5 DO REGDT4^GMTSU
SET PN("CORRDT")=X
+6 QUIT
+7 ;
WRT ; Writes the component data
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 if GMTSNPG
DO HEADER
WRITE PN("DATE"),?16,PN("DOCTYPE"),?48,PN("AUTHOR"),?64,PN("CORRDT"),!
+3 IF $DATA(^UTILITY($JOB,"W",1,2,0))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?16,^UTILITY($JOB,"W",1,2,0),!
+4 KILL PN,^UTILITY($JOB)
+5 QUIT
+6 ;
FORMAT ; Calls ^DIWP to format Title
+1 NEW DIWF,DIWL,DIWR,X
+2 SET DIWF="C30"
SET DIWL=1
SET DIWR=30
SET X=PN("DOCTYPE")
DO ^DIWP
+3 QUIT
EXTIU(DFN,GMTST,GMTS1,GMTS2,GMTSN,GMTSX) ; Extract Patient/Visit VIA TIU
+1 NEW GMTSPV
SET GMTSPV=+($GET(GMTSPXGO))
IF GMTSPV
IF $LENGTH($TEXT(VISIT^TIULAPIC))
DO VISIT^TIULAPIC($GET(DFN),$GET(GMTST),$GET(GMTS1),$GET(GMTS2),$GET(GMTSN),$GET(GMTSX))
QUIT
+2 DO MAIN^TIULAPIC($GET(DFN),$GET(GMTST),$GET(GMTS1),$GET(GMTS2),$GET(GMTSN),$GET(GMTSX))
+3 QUIT
