GMTSPNB.m

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

 ;

HEADER ; Prints header

 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 ---GMTSPNB   2430     printed  Feb 18, 2025@23:25:44                                                                                                                                                                                                     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      ;

HEADER    ; Prints header

 +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