VENPCC2A.m

VENPCC2A ; IHS/OIT/GIS - HEALTH SUMMARY GENERATOR ;

 ;;2.6;PCC+;;NOV 12, 2007

 ;

 ; VER 2.2 HS GENERATOR

 ; SUPPORTS OUTPUT FOR NEW PRINT SERVICE

 ; 

HS(APCHSPAT,APCHSTYP,VISIT,DEPTIEN) ; EP-GENERATE A HEALTH SUMMARY

 N PATH2,PATH3

 I $D(^AUPNPAT(+$G(APCHSPAT),0)),$D(^APCHSCTL(+$G(APCHSTYP),0)),$D(^VEN(7.95,+$G(DEPTIEN),0))

 E  Q

 I '$L($T(EN1^APCHS)) N ERR S ERR="Missing APCHS/APCHS0 patches.  Can't print health summary!" D ERR^VENPCC1(ERR) Q

 S %=$G(^VEN(7.5,+$G(CFIGIEN),2)) I %="" D ERR7^VENPCC1 Q

 S PATH2=%,%=$G(^VEN(7.5,+$G(CFIGIEN),3)) I %="" D ERR7^VENPCC1 Q

 S PATH3=%

NEW NEW %,%FN,%I,%T,%Y,APCHSFNM,APCHSIC,APCHSICD,APCHSICL,APCHSIR,APCHSNRQ,APCHSPDN,APCHSSGY,APCHSMTY,APCHSTAT,ARRAY,FILE,HEAD,I,POP,STOP,TAB,TMP,X,Y,APCHSERR,APCHSBWR

 S TMP="^TMP(""VEN HS"",$J)",FILE="T"_VISIT_".TXT" K @TMP

 S IOST="P-PRINTER",IOSL=99999,IOM=80

 D DEL^VENPCCP1(PATH3,FILE) ; CLEAN UP THE TMP FILE ; PATCHED BY GIS 2/20/07

 S POP=$$OPN^VENPCCP(PATH3,FILE,"W","N IO S IO=DEV D EN1^APCHS") K ^TMP($J,"APCHSMED") I POP Q

 S POP=$$OPN^VENPCCP(PATH3,FILE,"R","D LINE^VENPCC2A") I POP Q

 D DEL^VENPCCP1(PATH3,FILE) ; CLEAN UP THE TMP FILE AGAIN

PASS ; FIRST PASS THROUGH THE ARRAY

 NEW %,I,PATIENT,SCNT,SNO,STOP,X

 S SCNT=0

 S %=$G(@TMP@(0,2)) I '$L(%) S ERR="Unable to generate health summary.  Directory may be full!" D ERR^VENPCC1(ERR) Q  ; /usr directory or descendent is full

 S %=$P(%,"** ",2),%=$P(%," **") S @TMP@(2,"H1")=%

 S %=$P(@TMP@(0,3),"** ",2),@TMP@(2,"H2")="  "_$P(%,"pg")

 S @TMP@(2,"HEADER")="HS",@TMP@(2,"TEMPLATE")="HS2",@TMP@(2,"PRINTER")=""

 S (%,PATIENT)=$P($G(^DPT(APCHSPAT,0)),U) I '$L(%) D ERR3^VENPCC1 S STOP=1 Q

 S X=$P(%,",",2,99)_" "_$P(%,",")

 I $G(DFN),$G(DEPTIEN) S X=X_"  #"_$$CHART^VENPCC1A(DEPTIEN,DFN)

 S @TMP@(2,"FOOTER")=X

 S I=0 F  S I=$O(@TMP@(0,I)) Q:'I  S X=^(I) D

 . I X["** END" K @TMP@(0,I-1),^(I),^(I+1)

 . I X[("**"_$E(PATIENT,1,20)) K @TMP@(0,I) Q

 . I X["CONFIDENTIAL PATIENT" K @TMP@(0,I) Q

 . I $L(X)>50,$E(X)="-",$E(X,$L(X))="-" S %=$$STRIP^VENPCCU(X) S @TMP@(1,I)=% K @TMP@(0,I-1),^(I+1)

 . Q

 S SNO=0 F  S SNO=$O(@TMP@(1,SNO)) Q:'SNO  D SEC(SNO) I $G(STOP) Q

 D EXP

 K @TMP

 D AUDIT(APCHSPAT,DUZ,$G(DEPTIEN),$G(VISIT))

 Q

 ;

LINE F I=1:1 R X:30 Q:$$STATUS^%ZISH!(X["** END ")  S @TMP@(0,I)=X

 Q

 ; 

SEC(SNO) ; EP-PROCESS A SECTION

 NEW %,COMP,INO,NAME,REF,X,Y,LINE,LNO,STOP

 S NAME=@TMP@(1,SNO),COMP=$P(NAME," (")

 S SCNT=SCNT+1,STOP=0

SEC1 S @TMP@(2,("S"_SCNT))=NAME,INO=0,LNO=SNO

 F  S LNO=$O(@TMP@(0,LNO)) Q:'LNO  S LINE=^(LNO) D  I STOP Q

 . I $E(LINE)="-",$E(LINE,$L(LINE))="-" S STOP=1 Q  ; QUIT WHEN YOU REACH THE START OF NEXT SECTION

 . D SET($C(9)_LINE) ; ATTACH A VALUE TO A FIELD.  ALL FIELDS MUST START WITH A TAB CHARACTER

 . Q

 D SET($C(9))

 Q

 ;

SET(X) ; EP-SAVE TMP GLOBALS

 I X[U S X=$TR(X,U,"")

 S INO=INO+1

 I INO=44,SCNT=10 S @TMP@(2,"S1044")="",INO=45  ; FIXES PRINT SERVICE PROBLEM

 ; I INO>50 S:INO=51 @TMP@(2,("S"_(SCNT*100+50)))="<<Space constraints prevent display of additional lines in this section!!!>>" Q

 S @TMP@(2,("S"_(SCNT*100+INO)))=X

 I INO=50 S SCNT=SCNT+1,INO=0 ; OVERLAP INTO THE NEXT SECTION

 Q

 ;

EXP ; EP-EXPORT THE MAIL MERGE FILE

 I $P($G(^VEN(7.5,CFIGIEN,13)),U) D  Q  ; IN VER 2.5, GO DIRECTLY DATA FILE BUILDER

 . N VER25,HSFLAG

 . S VER25=1 S HSFLAG=1

 . D TCP^VENPCC1 Q

 . Q

 ; TRADITIONAL HS EXPORT...

 NEW %,%FN,FILE,I,LINE,LNO,NAME,X,Y,Z,PATH

 S @TMP@(3,1)="HEADER",^(2)="TEMPLATE",^(3)="GROUP",^(4)="PRINTER",^(5)="H1",^(6)="H2"

 S I=6 F X=1:1:25 F Y=1:1:50 D

 . I Y=1 S I=I+1,@TMP@(3,I)="S"_X,Z=X*100

 . S I=I+1,@TMP@(3,I)="S"_(Z+Y)

 . Q

 S @TMP@(3,I+1)="FOOTER"

 N HSFLAG S HSFLAG=1

 D TCP^VENPCC1 ; TCP PRINT SERVICE

 Q

 ;

AUDIT(PAT,USER,SITE,VISIT)   ; EP-UPDATE AUDIT FILE

 NEW %,%DT,%I,%Q,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y,DLAYGO

 D NOW^%DTC S X=%

 S DIC="^VEN(7.8,",DIC(0)="L",DLAYGO=19707.8 D ^DIC

 I Y=-1 Q

 S DIE=DIC,DA=+Y

 S DR=".02////^ S X=$G(PAT);.03////^S X=$G(SITE);.04////^S X=USER"

 I '$G(VFLAG),$L($G(VISIT)),'$G(NOVISIT) S DR=DR_";.05////^S X=VISIT"

 I $G(APPDATE) S DR=DR_";.06////^S X=APPDATE"

 L +^VEN(7.8):0 I $T D ^DIE L -^VEN(7.8)

 Q

 ; 

VENPCC2A  ; IHS/OIT/GIS - HEALTH SUMMARY GENERATOR ;

 +1       ;;2.6;PCC+;;NOV 12, 2007

 +2       ;

 +3       ; VER 2.2 HS GENERATOR

 +4       ; SUPPORTS OUTPUT FOR NEW PRINT SERVICE

 +5       ; 

HS(APCHSPAT,APCHSTYP,VISIT,DEPTIEN) ; EP-GENERATE A HEALTH SUMMARY

 +1        NEW PATH2,PATH3

 +2        IF $DATA(^AUPNPAT(+$GET(APCHSPAT),0))

               IF $DATA(^APCHSCTL(+$GET(APCHSTYP),0))

                   IF $DATA(^VEN(7.95,+$GET(DEPTIEN),0))

 +3       IF '$TEST

               QUIT 

 +4        IF '$LENGTH($TEXT(EN1^APCHS))

               NEW ERR

               SET ERR="Missing APCHS/APCHS0 patches.  Can't print health summary!"

               DO ERR^VENPCC1(ERR)

               QUIT 

 +5        SET %=$GET(^VEN(7.5,+$GET(CFIGIEN),2))

           IF %=""

               DO ERR7^VENPCC1

               QUIT 

 +6        SET PATH2=%

           SET %=$GET(^VEN(7.5,+$GET(CFIGIEN),3))

           IF %=""

               DO ERR7^VENPCC1

               QUIT 

 +7        SET PATH3=%

NEW        NEW %,%FN,%I,%T,%Y,APCHSFNM,APCHSIC,APCHSICD,APCHSICL,APCHSIR,APCHSNRQ,APCHSPDN,APCHSSGY,APCHSMTY,APCHSTAT,ARRAY,FILE,HEAD,I,POP,STOP,TAB,TMP,X,Y,APCHSERR,APCHSBWR

 +1        SET TMP="^TMP(""VEN HS"",$J)"

           SET FILE="T"_VISIT_".TXT"

           KILL @TMP

 +2        SET IOST="P-PRINTER"

           SET IOSL=99999

           SET IOM=80

 +3       ; CLEAN UP THE TMP FILE ; PATCHED BY GIS 2/20/07

           DO DEL^VENPCCP1(PATH3,FILE)

 +4        SET POP=$$OPN^VENPCCP(PATH3,FILE,"W","N IO S IO=DEV D EN1^APCHS")

           KILL ^TMP($JOB,"APCHSMED")

           IF POP

               QUIT 

 +5        SET POP=$$OPN^VENPCCP(PATH3,FILE,"R","D LINE^VENPCC2A")

           IF POP

               QUIT 

 +6       ; CLEAN UP THE TMP FILE AGAIN

           DO DEL^VENPCCP1(PATH3,FILE)

PASS      ; FIRST PASS THROUGH THE ARRAY

 +1        NEW %,I,PATIENT,SCNT,SNO,STOP,X

 +2        SET SCNT=0

 +3       ; /usr directory or descendent is full

           SET %=$GET(@TMP@(0,2))

           IF '$LENGTH(%)

               SET ERR="Unable to generate health summary.  Directory may be full!"

               DO ERR^VENPCC1(ERR)

               QUIT 

 +4        SET %=$PIECE(%,"** ",2)

           SET %=$PIECE(%," **")

           SET @TMP@(2,"H1")=%

 +5        SET %=$PIECE(@TMP@(0,3),"** ",2)

           SET @TMP@(2,"H2")="  "_$PIECE(%,"pg")

 +6        SET @TMP@(2,"HEADER")="HS"

           SET @TMP@(2,"TEMPLATE")="HS2"

           SET @TMP@(2,"PRINTER")=""

 +7        SET (%,PATIENT)=$PIECE($GET(^DPT(APCHSPAT,0)),U)

           IF '$LENGTH(%)

               DO ERR3^VENPCC1

               SET STOP=1

               QUIT 

 +8        SET X=$PIECE(%,",",2,99)_" "_$PIECE(%,",")

 +9        IF $GET(DFN)

               IF $GET(DEPTIEN)

                   SET X=X_"  #"_$$CHART^VENPCC1A(DEPTIEN,DFN)

 +10       SET @TMP@(2,"FOOTER")=X

 +11       SET I=0

           FOR 

               SET I=$ORDER(@TMP@(0,I))

               IF 'I

                   QUIT 

               SET X=^(I)

               Begin DoDot:1

 +12               IF X["** END"

                       KILL @TMP@(0,I-1),^(I),^(I+1)

 +13               IF X[("**"_$EXTRACT(PATIENT,1,20))

                       KILL @TMP@(0,I)

                       QUIT 

 +14               IF X["CONFIDENTIAL PATIENT"

                       KILL @TMP@(0,I)

                       QUIT 

 +15               IF $LENGTH(X)>50

                       IF $EXTRACT(X)="-"

                           IF $EXTRACT(X,$LENGTH(X))="-"

                               SET %=$$STRIP^VENPCCU(X)

                               SET @TMP@(1,I)=%

                               KILL @TMP@(0,I-1),^(I+1)

 +16               QUIT 

               End DoDot:1

 +17       SET SNO=0

           FOR 

               SET SNO=$ORDER(@TMP@(1,SNO))

               IF 'SNO

                   QUIT 

               DO SEC(SNO)

               IF $GET(STOP)

                   QUIT 

 +18       DO EXP

 +19       KILL @TMP

 +20       DO AUDIT(APCHSPAT,DUZ,$GET(DEPTIEN),$GET(VISIT))

 +21       QUIT 

 +22      ;

LINE       FOR I=1:1

               READ X:30

               IF $$STATUS^%ZISH!(X["** END ")

                   QUIT 

               SET @TMP@(0,I)=X

 +1        QUIT 

 +2       ; 

SEC(SNO)  ; EP-PROCESS A SECTION

 +1        NEW %,COMP,INO,NAME,REF,X,Y,LINE,LNO,STOP

 +2        SET NAME=@TMP@(1,SNO)

           SET COMP=$PIECE(NAME," (")

 +3        SET SCNT=SCNT+1

           SET STOP=0

SEC1       SET @TMP@(2,("S"_SCNT))=NAME

           SET INO=0

           SET LNO=SNO

 +1        FOR 

               SET LNO=$ORDER(@TMP@(0,LNO))

               IF 'LNO

                   QUIT 

               SET LINE=^(LNO)

               Begin DoDot:1

 +2       ; QUIT WHEN YOU REACH THE START OF NEXT SECTION

                   IF $EXTRACT(LINE)="-"

                       IF $EXTRACT(LINE,$LENGTH(LINE))="-"

                           SET STOP=1

                           QUIT 

 +3       ; ATTACH A VALUE TO A FIELD.  ALL FIELDS MUST START WITH A TAB CHARACTER

                   DO SET($CHAR(9)_LINE)

 +4                QUIT 

               End DoDot:1

               IF STOP

                   QUIT 

 +5        DO SET($CHAR(9))

 +6        QUIT 

 +7       ;

SET(X)    ; EP-SAVE TMP GLOBALS

 +1        IF X[U

               SET X=$TRANSLATE(X,U,"")

 +2        SET INO=INO+1

 +3       ; FIXES PRINT SERVICE PROBLEM

           IF INO=44

               IF SCNT=10

                   SET @TMP@(2,"S1044")=""

                   SET INO=45

 +4       ; I INO>50 S:INO=51 @TMP@(2,("S"_(SCNT*100+50)))="<<Space constraints prevent display of additional lines in this section!!!>>" Q

 +5        SET @TMP@(2,("S"_(SCNT*100+INO)))=X

 +6       ; OVERLAP INTO THE NEXT SECTION

           IF INO=50

               SET SCNT=SCNT+1

               SET INO=0

 +7        QUIT 

 +8       ;

EXP       ; EP-EXPORT THE MAIL MERGE FILE

 +1       ; IN VER 2.5, GO DIRECTLY DATA FILE BUILDER

           IF $PIECE($GET(^VEN(7.5,CFIGIEN,13)),U)

               Begin DoDot:1

 +2                NEW VER25,HSFLAG

 +3                SET VER25=1

                   SET HSFLAG=1

 +4                DO TCP^VENPCC1

                   QUIT 

 +5                QUIT 

               End DoDot:1

               QUIT 

 +6       ; TRADITIONAL HS EXPORT...

 +7        NEW %,%FN,FILE,I,LINE,LNO,NAME,X,Y,Z,PATH

 +8        SET @TMP@(3,1)="HEADER"

           SET ^(2)="TEMPLATE"

           SET ^(3)="GROUP"

           SET ^(4)="PRINTER"

           SET ^(5)="H1"

           SET ^(6)="H2"

 +9        SET I=6

           FOR X=1:1:25

               FOR Y=1:1:50

                   Begin DoDot:1

 +10                   IF Y=1

                           SET I=I+1

                           SET @TMP@(3,I)="S"_X

                           SET Z=X*100

 +11                   SET I=I+1

                       SET @TMP@(3,I)="S"_(Z+Y)

 +12                   QUIT 

                   End DoDot:1

 +13       SET @TMP@(3,I+1)="FOOTER"

 +14       NEW HSFLAG

           SET HSFLAG=1

 +15      ; TCP PRINT SERVICE

           DO TCP^VENPCC1

 +16       QUIT 

 +17      ;

AUDIT(PAT,USER,SITE,VISIT) ; EP-UPDATE AUDIT FILE

 +1        NEW %,%DT,%I,%Q,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y,DLAYGO

 +2        DO NOW^%DTC

           SET X=%

 +3        SET DIC="^VEN(7.8,"

           SET DIC(0)="L"

           SET DLAYGO=19707.8

           DO ^DIC

 +4        IF Y=-1

               QUIT 

 +5        SET DIE=DIC

           SET DA=+Y

 +6        SET DR=".02////^ S X=$G(PAT);.03////^S X=$G(SITE);.04////^S X=USER"

 +7        IF '$GET(VFLAG)

               IF $LENGTH($GET(VISIT))

                   IF '$GET(NOVISIT)

                       SET DR=DR_";.05////^S X=VISIT"

 +8        IF $GET(APPDATE)

               SET DR=DR_";.06////^S X=APPDATE"

 +9        LOCK +^VEN(7.8):0

           IF $TEST

               DO ^DIE

               LOCK -^VEN(7.8)

 +10       QUIT 

 +11      ;