GMPLHSPL ; SLC/MKB -- Problem List HS Component Driver (for export) ;11/23/93 10:36
;;2.0;Problem List;;Aug 25, 1994
GMTSPLST ; SLC/DJP -- Problem List HS Component Driver ;5/27/93 15:35
;;2.5;Health Summary;;
ACTIVE ;
S STATUS="A" D MAIN,KILL Q
INACT S STATUS="I" D MAIN,KILL Q
ALL S STATUS="ALL" D MAIN,KILL Q
MAIN ;Driver
D CKP^GMTSUP Q:$D(GMTSQIT) I 'GMTSNPG D BREAK^GMTSUP
D ^GMPLHS
I '$D(^TMP("GMPLHS",$J)) D NOPROBS Q
W ! D SUBHDR
D CKP^GMTSUP Q:$D(GMTSQIT) W !
D WRT
Q
;
KILL D KILL^GMPLHS
Q
;
NOPROBS ;Indicates problems not on file for patient
D CKP^GMTSUP Q:$D(GMTSQIT) W "No data available.",!
Q
SUBHDR ; Subheader for Problem List Component
N NUM S NUM=GMPCOUNT S:GMPTOTAL>GMPCOUNT NUM=NUM_" of "_GMPTOTAL
S NUM=NUM_$S(STATUS="A":" Active",STATUS="I":" Inactive",1:"")_" Problems"
D CKP^GMTSUP Q:$D(GMTSQIT) ;I 'GMTSNPG D BREAK^GMTSUP
W ?56,NUM,!
D CKP^GMTSUP Q:$D(GMTSQIT) ;I 'GMTSNPG D BREAK^GMTSUP
W ?6,"PROBLEM",?46,"LAST MOD",?56,"SERVICE/PROVIDER",!
Q
;
WRT ; Writes Problem List Component
S GMPI=0 F GMPI=0:0 S GMPI=$O(^TMP("GMPLHS",$J,STATUS,GMPI)) Q:GMPI'>0 D LINE
Q
;
LINE ;Prints individual line
D CKP^GMTSUP Q:$D(GMTSQIT) ;I 'GMTSNPG D BREAK^GMTSUP
N PROBLEM,TEXT,I,PROB,MAX
S PROBLEM=$G(^TMP("GMPLHS",$J,STATUS,GMPI,0))
S PROB=$P(PROBLEM,U,2),MAX=38 D WRAP^GMPLX(PROB,MAX,.TEXT)
I STATUS="ALL" W ?3,$P(PROBLEM,"^",1)
W ?6,TEXT(1),?46,$P(PROBLEM,"^",3),?56,$P(PROBLEM,"^",4),!
I TEXT>1 F I=2:1:TEXT W ?8,TEXT(I),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLHSPL 1530 printed Dec 13, 2024@02:30:06 Page 2
GMPLHSPL ; SLC/MKB -- Problem List HS Component Driver (for export) ;11/23/93 10:36
+1 ;;2.0;Problem List;;Aug 25, 1994
GMTSPLST ; SLC/DJP -- Problem List HS Component Driver ;5/27/93 15:35
+1 ;;2.5;Health Summary;;
ACTIVE ;
+1 SET STATUS="A"
DO MAIN
DO KILL
QUIT
INACT SET STATUS="I"
DO MAIN
DO KILL
QUIT
ALL SET STATUS="ALL"
DO MAIN
DO KILL
QUIT
MAIN ;Driver
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
IF 'GMTSNPG
DO BREAK^GMTSUP
+2 DO ^GMPLHS
+3 IF '$DATA(^TMP("GMPLHS",$JOB))
DO NOPROBS
QUIT
+4 WRITE !
DO SUBHDR
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !
+6 DO WRT
+7 QUIT
+8 ;
KILL DO KILL^GMPLHS
+1 QUIT
+2 ;
NOPROBS ;Indicates problems not on file for patient
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "No data available.",!
+2 QUIT
SUBHDR ; Subheader for Problem List Component
+1 NEW NUM
SET NUM=GMPCOUNT
if GMPTOTAL>GMPCOUNT
SET NUM=NUM_" of "_GMPTOTAL
+2 SET NUM=NUM_$SELECT(STATUS="A":" Active",STATUS="I":" Inactive",1:"")_" Problems"
+3 ;I 'GMTSNPG D BREAK^GMTSUP
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE ?56,NUM,!
+5 ;I 'GMTSNPG D BREAK^GMTSUP
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE ?6,"PROBLEM",?46,"LAST MOD",?56,"SERVICE/PROVIDER",!
+7 QUIT
+8 ;
WRT ; Writes Problem List Component
+1 SET GMPI=0
FOR GMPI=0:0
SET GMPI=$ORDER(^TMP("GMPLHS",$JOB,STATUS,GMPI))
if GMPI'>0
QUIT
DO LINE
+2 QUIT
+3 ;
LINE ;Prints individual line
+1 ;I 'GMTSNPG D BREAK^GMTSUP
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 NEW PROBLEM,TEXT,I,PROB,MAX
+3 SET PROBLEM=$GET(^TMP("GMPLHS",$JOB,STATUS,GMPI,0))
+4 SET PROB=$PIECE(PROBLEM,U,2)
SET MAX=38
DO WRAP^GMPLX(PROB,MAX,.TEXT)
+5 IF STATUS="ALL"
WRITE ?3,$PIECE(PROBLEM,"^",1)
+6 WRITE ?6,TEXT(1),?46,$PIECE(PROBLEM,"^",3),?56,$PIECE(PROBLEM,"^",4),!
+7 IF TEXT>1
FOR I=2:1:TEXT
WRITE ?8,TEXT(I),!
+8 QUIT
