- ACHSDFC ; IHS/ITSC/PMF - DEFERRED SERVICE CANCEL ; [ 12/06/2002 10:36 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- ;ACHS*3.1*4 patient lookup changes
- ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Prevent <UNDEF>.
- ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
- ;
- D VIDEO^ACHS
- LOOK ; --- Lookup a Deferred service, ask Cancel
- N ACHSDA,DA,DIC,DIE,DR
- W !!
- ;
- ;ACHS*3.1*4 4/19/02 pmf change patient look up
- ;S DIC="^ACHSDEF("_DUZ(2)_",""D""," ; ACHS*3.1*4
- ;S DIC(0)="QAEMZ" ; ACHS*3.1*4
- ;S DA(1)=DUZ(2) ; ACHS*3.1*4
- ;S DIC("A")="Enter the DEFERRED SERVICE NUMBER or PATIENT NAME: " ; ACHS*3.1*4
- ;S DIC("S")="I $E($P($G(^(0)),U))'=""#"",$P($G(^(0)),U,14)'=""Y""" ; ACHS*3.1*4
- ;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"")" ; ACHS*3.1*4
- ;D ^DIC ; ACHS*3.1*4
- ;I +Y<1 D END Q ; ACHS*3.1*4
- ;I $D(DTOUT)!$D(DUOUT) D END Q ; ACHS*3.1*4
- ;S ACHSDA=+Y ; ACHS*3.1*4
- ;
- ;{ABK, 3/31/10}K DFN S ACHDOCT="deferral" ; ACHS*3.1*4
- K DFN S ACHDOCT="unmet need" ; ACHS*3.1*4
- D ^ACHSDFLK ; ACHS*3.1*4
- I $D(ACHDLKER) D RTRN^ACHS Q ; ACHS*3.1*4
- S ACHSDA=ACHSA ; ACHS*3.1*4
- ;
- ;{ABK, 3/31/10}W !!,*7,*7,IORVON,"Are You Sure You Want To Cancel This Deferred Services Document? ",IORVOFF,!!,IORVON,"Once Cancelled It Can Never Be Retrieved Again.",IORVOFF,!!
- ;{ABK, 3/31/10}S %=$$DIR^ACHS("Y","Do you want to CANCEL this Deferred Services Document","NO","Once Cancelled It Can Never Be Retrieved Again.","",2)
- W !!,*7,*7,IORVON,"Are You Sure You Want To Cancel This Unmet Needs Document? ",IORVOFF,!!,IORVON,"Once Cancelled It Can Never Be Retrieved Again.",IORVOFF,!!
- S %=$$DIR^ACHS("Y","Do you want to CANCEL this Unmet Needs Document","NO","Once Cancelled It Can Never Be Retrieved Again.","",2)
- ;
- I $D(DUOUT)!$D(DTOUT) D END Q
- G NOT:'%
- ;
- SET ; --- Cancelling Deferred Service
- I '$$LOCK^ACHS("^ACHSDEF(DUZ(2),""D"",ACHSDA)","+") D END Q
- ;{ABK, 3/31/10}W !!,*7,*7,"Now Cancelling Deferred Service Number ",$$DF^ACHS(0,1),IORVOFF
- W !!,*7,*7,"Now Cancelling Unmet Need Number ",$$DF^ACHS(0,1),IORVOFF
- S DA=ACHSDA
- ;
- ;S DIE=DIC;ACHS*3.1*5 12/06/2002
- S DIE="^ACHSDEF("_DUZ(2)_",""D""," ;ACHS*3.1*5 12/06/2002
- ;
- S DR="14///Y"
- D ^DIE
- ;{ABK, 3/31/10}W !!,*7,*7,"DEFERRED SERVICES DOCUMENT CANCELLED",!!
- W !!,*7,*7,"UNMET NEEDS DOCUMENT CANCELLED",!!
- I '$$LOCK^ACHS("^ACHSDEF(DUZ(2),""D"",ACHSDA)","-")
- D END
- Q
- ;
- NOT ;
- ;{ABK, 3/31/10}W !!,*7,*7,"DEFERRED SERVICE DOCUMENT NOT CANCELLED, LEFT UNCHANGED",!!
- W !!,*7,*7,"UNMET NEED DOCUMENT NOT CANCELLED, LEFT UNCHANGED",!!
- END ;
- D RTRN^ACHS
- Q
- ;
- ACHSDFC ; IHS/ITSC/PMF - DEFERRED SERVICE CANCEL ; [ 12/06/2002 10:36 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- +2 ;ACHS*3.1*4 patient lookup changes
- +3 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Prevent <UNDEF>.
- +4 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
- +5 ;
- +6 DO VIDEO^ACHS
- LOOK ; --- Lookup a Deferred service, ask Cancel
- +1 NEW ACHSDA,DA,DIC,DIE,DR
- +2 WRITE !!
- +3 ;
- +4 ;ACHS*3.1*4 4/19/02 pmf change patient look up
- +5 ;S DIC="^ACHSDEF("_DUZ(2)_",""D""," ; ACHS*3.1*4
- +6 ;S DIC(0)="QAEMZ" ; ACHS*3.1*4
- +7 ;S DA(1)=DUZ(2) ; ACHS*3.1*4
- +8 ;S DIC("A")="Enter the DEFERRED SERVICE NUMBER or PATIENT NAME: " ; ACHS*3.1*4
- +9 ;S DIC("S")="I $E($P($G(^(0)),U))'=""#"",$P($G(^(0)),U,14)'=""Y""" ; ACHS*3.1*4
- +10 ;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"")" ; ACHS*3.1*4
- +11 ;D ^DIC ; ACHS*3.1*4
- +12 ;I +Y<1 D END Q ; ACHS*3.1*4
- +13 ;I $D(DTOUT)!$D(DUOUT) D END Q ; ACHS*3.1*4
- +14 ;S ACHSDA=+Y ; ACHS*3.1*4
- +15 ;
- +16 ;{ABK, 3/31/10}K DFN S ACHDOCT="deferral" ; ACHS*3.1*4
- +17 ; ACHS*3.1*4
- KILL DFN
- SET ACHDOCT="unmet need"
- +18 ; ACHS*3.1*4
- DO ^ACHSDFLK
- +19 ; ACHS*3.1*4
- IF $DATA(ACHDLKER)
- DO RTRN^ACHS
- QUIT
- +20 ; ACHS*3.1*4
- SET ACHSDA=ACHSA
- +21 ;
- +22 ;{ABK, 3/31/10}W !!,*7,*7,IORVON,"Are You Sure You Want To Cancel This Deferred Services Document? ",IORVOFF,!!,IORVON,"Once Cancelled It Can Never Be Retrieved Again.",IORVOFF,!!
- +23 ;{ABK, 3/31/10}S %=$$DIR^ACHS("Y","Do you want to CANCEL this Deferred Services Document","NO","Once Cancelled It Can Never Be Retrieved Again.","",2)
- +24 WRITE !!,*7,*7,IORVON,"Are You Sure You Want To Cancel This Unmet Needs Document? ",IORVOFF,!!,IORVON,"Once Cancelled It Can Never Be Retrieved Again.",IORVOFF,!!
- +25 SET %=$$DIR^ACHS("Y","Do you want to CANCEL this Unmet Needs Document","NO","Once Cancelled It Can Never Be Retrieved Again.","",2)
- +26 ;
- +27 IF $DATA(DUOUT)!$DATA(DTOUT)
- DO END
- QUIT
- +28 IF '%
- GOTO NOT
- +29 ;
- SET ; --- Cancelling Deferred Service
- +1 IF '$$LOCK^ACHS("^ACHSDEF(DUZ(2),""D"",ACHSDA)","+")
- DO END
- QUIT
- +2 ;{ABK, 3/31/10}W !!,*7,*7,"Now Cancelling Deferred Service Number ",$$DF^ACHS(0,1),IORVOFF
- +3 WRITE !!,*7,*7,"Now Cancelling Unmet Need Number ",$$DF^ACHS(0,1),IORVOFF
- +4 SET DA=ACHSDA
- +5 ;
- +6 ;S DIE=DIC;ACHS*3.1*5 12/06/2002
- +7 ;ACHS*3.1*5 12/06/2002
- SET DIE="^ACHSDEF("_DUZ(2)_",""D"","
- +8 ;
- +9 SET DR="14///Y"
- +10 DO ^DIE
- +11 ;{ABK, 3/31/10}W !!,*7,*7,"DEFERRED SERVICES DOCUMENT CANCELLED",!!
- +12 WRITE !!,*7,*7,"UNMET NEEDS DOCUMENT CANCELLED",!!
- +13 IF '$$LOCK^ACHS("^ACHSDEF(DUZ(2),""D"",ACHSDA)","-")
- +14 DO END
- +15 QUIT
- +16 ;
- NOT ;
- +1 ;{ABK, 3/31/10}W !!,*7,*7,"DEFERRED SERVICE DOCUMENT NOT CANCELLED, LEFT UNCHANGED",!!
- +2 WRITE !!,*7,*7,"UNMET NEED DOCUMENT NOT CANCELLED, LEFT UNCHANGED",!!
- END ;
- +1 DO RTRN^ACHS
- +2 QUIT
- +3 ;
