AZXAPTR.m

AZXAPTR ; IHS/PHXAO/TMJ - PT RECORD ;

 ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002

 ;

 ;

START ;Get Patient

 S AZXAPAT=""

 D GETPAT

 I AZXAPAT="" W !!,"No PATIENT Selected!" D EOJ Q

 D GETDIS

 D EOJ

 Q

 ;

GETPAT ;Get Patient Name

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S AZXAPAT=+Y

 Q

 ;

GETDIS ;Get this Patient's Disclosure Records

 ;

 Q:'AZXAPAT

 S AZXACT=0

 D HEADER

 S AZXAIEN="" F  S AZXAIEN=$O(^AZXAREC("E",AZXAPAT,AZXAIEN)) Q:AZXAIEN'=+AZXAIEN  D

 . S AZXACT=AZXACT+1

 . S AZXADN=$P($G(^AZXAREC(AZXAIEN,0)),U,2)

 . S AZXADT=$P($G(^AZXAREC(AZXAIEN,0)),U)

 . S AZXADTP=$$FMTE^XLFDT(AZXADT,"2P")

 . S AZXAPTY=$P($G(^AZXAREC(AZXAIEN,0)),U,6)

 . S AZXAPTYP=$P($G(^AZXAREQ(AZXAPTY,0)),U)

 . S AZXATYP=$P($G(^AZXAREC(AZXAIEN,0)),U,4)

 . S AZXAST=$P($G(^AZXAREC(AZXAIEN,0)),U,8)

 . W ?5,AZXACT_")",?12,AZXADN,?23,AZXADTP,?37,AZXAPTYP,?62,AZXATYP,?73,AZXAST,!

 I AZXACT=0 W !,?5,"**NO DISCLOSURE RECORDS TO PRINT FOR THIS PATIENT**",!

 ;

 Q

PRINT ;Print the Disclosure Records

 ;

 ;

 Q

 ;

HEADER ;Print the Header for Display

 W !!,?5,"CUMMULATIVE DISCLOSURE RECORDS FOR: "_$P($G(^DPT(AZXAPAT,0)),U),!

 W ?5,"DISPLAY DATE: "_$$FMTE^XLFDT(DT,"1P")

 ;W !!,?5,"PT NAME",?40,"DISCLOSURE #",?55,"DISC DT",!!

 W !!,?3,"Number",?12,"DISC #",?23,"DT REC'D",?37,"REQUESTING PARTY",?60,"TYPE",?70,"STATUS",!

 W ?3,"____________________________________________________________________________",!

 Q

EOJ ;End of Job

 K %,%DT,%X,%Y

 K AZXAPAT,AZXADIS,AZXACT,AZXADN,AZXADT,AZXADTP,AZXAIEN,AZXAPTY,AZXAPTYP,AZXATYP,AZXAST

 D KILL^AUPNPAT

 Q

AZXAPTR   ; IHS/PHXAO/TMJ - PT RECORD ;

 +1       ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002

 +2       ;

 +3       ;

START     ;Get Patient

 +1        SET AZXAPAT=""

 +2        DO GETPAT

 +3        IF AZXAPAT=""

               WRITE !!,"No PATIENT Selected!"

               DO EOJ

               QUIT 

 +4        DO GETDIS

 +5        DO EOJ

 +6        QUIT 

 +7       ;

GETPAT    ;Get Patient Name

 +1        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y<0

               QUIT 

 +3        SET AZXAPAT=+Y

 +4        QUIT 

 +5       ;

GETDIS    ;Get this Patient's Disclosure Records

 +1       ;

 +2        IF 'AZXAPAT

               QUIT 

 +3        SET AZXACT=0

 +4        DO HEADER

 +5        SET AZXAIEN=""

           FOR 

               SET AZXAIEN=$ORDER(^AZXAREC("E",AZXAPAT,AZXAIEN))

               IF AZXAIEN'=+AZXAIEN

                   QUIT 

               Begin DoDot:1

 +6                SET AZXACT=AZXACT+1

 +7                SET AZXADN=$PIECE($GET(^AZXAREC(AZXAIEN,0)),U,2)

 +8                SET AZXADT=$PIECE($GET(^AZXAREC(AZXAIEN,0)),U)

 +9                SET AZXADTP=$$FMTE^XLFDT(AZXADT,"2P")

 +10               SET AZXAPTY=$PIECE($GET(^AZXAREC(AZXAIEN,0)),U,6)

 +11               SET AZXAPTYP=$PIECE($GET(^AZXAREQ(AZXAPTY,0)),U)

 +12               SET AZXATYP=$PIECE($GET(^AZXAREC(AZXAIEN,0)),U,4)

 +13               SET AZXAST=$PIECE($GET(^AZXAREC(AZXAIEN,0)),U,8)

 +14               WRITE ?5,AZXACT_")",?12,AZXADN,?23,AZXADTP,?37,AZXAPTYP,?62,AZXATYP,?73,AZXAST,!

               End DoDot:1

 +15       IF AZXACT=0

               WRITE !,?5,"**NO DISCLOSURE RECORDS TO PRINT FOR THIS PATIENT**",!

 +16      ;

 +17       QUIT 

PRINT     ;Print the Disclosure Records

 +1       ;

 +2       ;

 +3        QUIT 

 +4       ;

HEADER    ;Print the Header for Display

 +1        WRITE !!,?5,"CUMMULATIVE DISCLOSURE RECORDS FOR: "_$PIECE($GET(^DPT(AZXAPAT,0)),U),!

 +2        WRITE ?5,"DISPLAY DATE: "_$$FMTE^XLFDT(DT,"1P")

 +3       ;W !!,?5,"PT NAME",?40,"DISCLOSURE #",?55,"DISC DT",!!

 +4        WRITE !!,?3,"Number",?12,"DISC #",?23,"DT REC'D",?37,"REQUESTING PARTY",?60,"TYPE",?70,"STATUS",!

 +5        WRITE ?3,"____________________________________________________________________________",!

 +6        QUIT 

EOJ       ;End of Job

 +1        KILL %,%DT,%X,%Y

 +2        KILL AZXAPAT,AZXADIS,AZXACT,AZXADN,AZXADT,AZXADTP,AZXAIEN,AZXAPTY,AZXAPTYP,AZXATYP,AZXAST

 +3        DO KILL^AUPNPAT

 +4        QUIT