APCDEFU.m

APCDEFU ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Utility ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;This routine contains the header, footer, and form feed utilities

 ;for the Automated PCC Encounter Form

 ;

 ;

HEAD ;EP-- this is the report header

 S APCDQ=0 W:$D(IOF) @IOF

XHEAD W !!?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?30,"PCC ENCOUNTER RECORD"

 ;W !?18,"***  Computer Generated Encounter Record  ***"

 S X="***  Computed Generated Encounter Record"_$S('$D(APCDGROP):"",1:" from GROUP FORM")_"  ***" W !,$$CTR(X,80)

 W !!,APCLSTAR

 W !!?3,"Visit Date/Time:  ",APCDVDT

 W ?40,"Primary Provider: ",$$PRIMPROV^APCLV(APCDVIEN,"N")

 W !?3,"Clinic:  ",$E(APCDVCLN,1,25),?39,$E(APCDVSC,1,14),?55,$E(APCDVHL,1,24)

 W !?3,"Location:  ",APCDVLOC,"   ",$$LOCENC^APCLV(APCDVIEN,"C")

 W !,APCLSTAR

 Q

 ;

FOOT ;EP-- page footer    

 S APCDPAT=$P(APCDVREC,U,5)

 S APCDHRN=$$HRN^AUPNPAT(APCDPAT,DUZ(2))

 S:APCDHRN="" APCDHRN="<?????>"

 W !,?3,"HR#:  ",APCDHRN,?30,"SSN:  ",$$SSN^AUPNPAT(APCDPAT)

 W !,?3,"NAME:  ",$$VAL^XBDIQ1(2,APCDPAT,.01)

 W ?30,"SEX: ",$$EXTSET^XBFUNC(2,.02,$P(^DPT(APCDPAT,0),U,2))

 W !?3,"DOB:  ",$$DOB^AUPNPAT(APCDPAT,"E")

 W ?30,"TRIBE: ",$$TRIBE^AUPNPAT(APCDPAT,"E")

 W !?3,"RESIDENCE:  ",$$COMMRES^AUPNPAT(APCDPAT,"E")

 W !?3,"FACILITY: ",$E($$VAL^XBDIQ1(4,DUZ(2),.01),1,25)

 W !!?30,"PROVIDER SIGNATURE:  "

 W !

 ;W !,APCLSTAR

 Q

 ;

FF ;-- form feed

 Q:$Y<(IOSL-5)

 S DFN=$P(APCDVREC,U,5)

 S APCDHRN=$$HRN^AUPNPAT(DFN,DUZ(2))

 S:APCDHRN="" APCDHRN="<?????>"

 W !,?3,"HR#:  ",APCDHRN,?30,"SSN:  ",$P(^DPT(DFN,0),U,9)

 W !,?3,"NAME:  ",APCDPAT

 I $E(IOST)="C" D

 . I IO=IO(0) W ! S DIR(0)="EO"

 . D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQ=1 Q

 W:$D(IOF) @IOF

 Q:$E(IOST,1,1)="C"

 D XHEAD

 Q

 ;

DONE ;EP-- kill tmp

 K ^XTMP(APCDJ,APCDH,"APCDEF")

 Q

 ;

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

APCDEFU   ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Utility ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;This routine contains the header, footer, and form feed utilities

 +4       ;for the Automated PCC Encounter Form

 +5       ;

 +6       ;

HEAD      ;EP-- this is the report header

 +1        SET APCDQ=0

           IF $DATA(IOF)

               WRITE @IOF

XHEAD      WRITE !!?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +1        WRITE !?30,"PCC ENCOUNTER RECORD"

 +2       ;W !?18,"***  Computer Generated Encounter Record  ***"

 +3        SET X="***  Computed Generated Encounter Record"_$SELECT('$DATA(APCDGROP):"",1:" from GROUP FORM")_"  ***"

           WRITE !,$$CTR(X,80)

 +4        WRITE !!,APCLSTAR

 +5        WRITE !!?3,"Visit Date/Time:  ",APCDVDT

 +6        WRITE ?40,"Primary Provider: ",$$PRIMPROV^APCLV(APCDVIEN,"N")

 +7        WRITE !?3,"Clinic:  ",$EXTRACT(APCDVCLN,1,25),?39,$EXTRACT(APCDVSC,1,14),?55,$EXTRACT(APCDVHL,1,24)

 +8        WRITE !?3,"Location:  ",APCDVLOC,"   ",$$LOCENC^APCLV(APCDVIEN,"C")

 +9        WRITE !,APCLSTAR

 +10       QUIT 

 +11      ;

FOOT      ;EP-- page footer    

 +1        SET APCDPAT=$PIECE(APCDVREC,U,5)

 +2        SET APCDHRN=$$HRN^AUPNPAT(APCDPAT,DUZ(2))

 +3        IF APCDHRN=""

               SET APCDHRN="<?????>"

 +4        WRITE !,?3,"HR#:  ",APCDHRN,?30,"SSN:  ",$$SSN^AUPNPAT(APCDPAT)

 +5        WRITE !,?3,"NAME:  ",$$VAL^XBDIQ1(2,APCDPAT,.01)

 +6        WRITE ?30,"SEX: ",$$EXTSET^XBFUNC(2,.02,$PIECE(^DPT(APCDPAT,0),U,2))

 +7        WRITE !?3,"DOB:  ",$$DOB^AUPNPAT(APCDPAT,"E")

 +8        WRITE ?30,"TRIBE: ",$$TRIBE^AUPNPAT(APCDPAT,"E")

 +9        WRITE !?3,"RESIDENCE:  ",$$COMMRES^AUPNPAT(APCDPAT,"E")

 +10       WRITE !?3,"FACILITY: ",$EXTRACT($$VAL^XBDIQ1(4,DUZ(2),.01),1,25)

 +11       WRITE !!?30,"PROVIDER SIGNATURE:  "

 +12       WRITE !

 +13      ;W !,APCLSTAR

 +14       QUIT 

 +15      ;

FF        ;-- form feed

 +1        IF $Y<(IOSL-5)

               QUIT 

 +2        SET DFN=$PIECE(APCDVREC,U,5)

 +3        SET APCDHRN=$$HRN^AUPNPAT(DFN,DUZ(2))

 +4        IF APCDHRN=""

               SET APCDHRN="<?????>"

 +5        WRITE !,?3,"HR#:  ",APCDHRN,?30,"SSN:  ",$PIECE(^DPT(DFN,0),U,9)

 +6        WRITE !,?3,"NAME:  ",APCDPAT

 +7        IF $EXTRACT(IOST)="C"

               Begin DoDot:1

 +8                IF IO=IO(0)

                       WRITE !

                       SET DIR(0)="EO"

 +9                DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET APCDQ=1

                       QUIT 

               End DoDot:1

 +10       IF $DATA(IOF)

               WRITE @IOF

 +11       IF $EXTRACT(IOST,1,1)="C"

               QUIT 

 +12       DO XHEAD

 +13       QUIT 

 +14      ;

DONE      ;EP-- kill tmp

 +1        KILL ^XTMP(APCDJ,APCDH,"APCDEF")

 +2        QUIT 

 +3       ;

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------