ACHSDF2.m

ACHSDF2 ; IHS/ITSC/PMF - UNMET NEED CAPTIONED DISPLAY ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001

 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need

 ;

DUMP ;EP - From Option.

 ;SKIP INCOMPLETE AND CANCELLED DOCUMENTS

 S DIC("S")="I $E($P($G(^(0)),U))'=""#"",$P($G(^(0)),U,14)'=""Y"""

 S DIC("W")="W "" ""_$S($P($G(^(0)),U,5)=""Y"":$P($G(^DPT($P($G(^(0)),U,6),0)),U),$P($G(^(0)),U,5)=""N"":$P($G(^(0)),U,7),1:""UNDEFINED"")"

 ;{ABK,6/30/10}S DIC="^ACHSDEF("_DUZ(2)_",""D"",",DIC(0)="QAZEMI",DIC("A")="Enter the DEFERRED SERVICE NUMBER or PATIENT NAME : "

 S DIC="^ACHSDEF("_DUZ(2)_",""D"",",DIC(0)="QAZEMI",DIC("A")="Enter the UNMET NEED NUMBER or PATIENT NAME : "

 D ^DIC

 G K:+Y<1

 S DA=+Y

 K DIC

DEV ;

 S %ZIS="OPQ"

 D ^%ZIS

 I POP D HOME^%ZIS G K

 G:'$D(IO("Q")) START

 K IO("Q")

 I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 ;{ABK,6/30/10}S ZTRTN="START^ACHSDF2",ZTDESC="CAPTIONED DISPLAY DEFERRED SERVICE DOC "_$P($G(^ACHSDEF(DUZ(2),"D",DA,0)),U)_"."

 S ZTRTN="START^ACHSDF2",ZTDESC="CAPTIONED DISPLAY UNMET NEED DOC "_$P($G(^ACHSDEF(DUZ(2),"D",DA,0)),U)_"."

 F %="DA" S ZTSAVE(%)=""

 D ^%ZTLOAD

 G DEV:'$D(ZTSK)

 K ZTSK

 G K

 ;

START ;EP - TaskMan.

 U IO

 S DIC="^ACHSDEF("_DUZ(2)_",""D"","

 D EN^DIQ

 I IO'=$G(ACHDIO) W @IOF

K ;

 K DA,DIC

 D ^%ZISC,ERPT^ACHS:$D(ZTSK)

 Q

 ;

ACHSDF2   ; IHS/ITSC/PMF - UNMET NEED CAPTIONED DISPLAY ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001

 +2       ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need

 +3       ;

DUMP      ;EP - From Option.

 +1       ;SKIP INCOMPLETE AND CANCELLED DOCUMENTS

 +2        SET DIC("S")="I $E($P($G(^(0)),U))'=""#"",$P($G(^(0)),U,14)'=""Y"""

 +3        SET DIC("W")="W "" ""_$S($P($G(^(0)),U,5)=""Y"":$P($G(^DPT($P($G(^(0)),U,6),0)),U),$P($G(^(0)),U,5)=""N"":$P($G(^(0)),U,7),1:""UNDEFINED"")"

 +4       ;{ABK,6/30/10}S DIC="^ACHSDEF("_DUZ(2)_",""D"",",DIC(0)="QAZEMI",DIC("A")="Enter the DEFERRED SERVICE NUMBER or PATIENT NAME : "

 +5        SET DIC="^ACHSDEF("_DUZ(2)_",""D"","

           SET DIC(0)="QAZEMI"

           SET DIC("A")="Enter the UNMET NEED NUMBER or PATIENT NAME : "

 +6        DO ^DIC

 +7        IF +Y<1

               GOTO K

 +8        SET DA=+Y

 +9        KILL DIC

DEV       ;

 +1        SET %ZIS="OPQ"

 +2        DO ^%ZIS

 +3        IF POP

               DO HOME^%ZIS

               GOTO K

 +4        IF '$DATA(IO("Q"))

               GOTO START

 +5        KILL IO("Q")

 +6        IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +7       ;{ABK,6/30/10}S ZTRTN="START^ACHSDF2",ZTDESC="CAPTIONED DISPLAY DEFERRED SERVICE DOC "_$P($G(^ACHSDEF(DUZ(2),"D",DA,0)),U)_"."

 +8        SET ZTRTN="START^ACHSDF2"

           SET ZTDESC="CAPTIONED DISPLAY UNMET NEED DOC "_$PIECE($GET(^ACHSDEF(DUZ(2),"D",DA,0)),U)_"."

 +9        FOR %="DA"

               SET ZTSAVE(%)=""

 +10       DO ^%ZTLOAD

 +11       IF '$DATA(ZTSK)

               GOTO DEV

 +12       KILL ZTSK

 +13       GOTO K

 +14      ;

START     ;EP - TaskMan.

 +1        USE IO

 +2        SET DIC="^ACHSDEF("_DUZ(2)_",""D"","

 +3        DO EN^DIQ

 +4        IF IO'=$GET(ACHDIO)

               WRITE @IOF

K         ;

 +1        KILL DA,DIC

 +2        DO ^%ZISC

           IF $DATA(ZTSK)

               DO ERPT^ACHS

 +3        QUIT 

 +4       ;