ACHSDFDP ; IHS/ITSC/PMF - DEFERRED SERVICES DISPLAY/EDIT ; [ 12/06/2002 10:36 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
Q:'$D(ACHSA)
Q:'$D(^ACHSDEF(DUZ(2),0))
Q:'$D(^ACHSDEF(DUZ(2),"D",ACHSA,0))
D VIDEO^ACHS
S:'$D(IORVON) IORVON=""
S:'$D(IORVOFF) IORVOFF=""
;
N ACHDFDP
F D HDR,PG Q:$D(DUOUT)!$D(DTOUT)!$D(ACHDONE)
END ;
Q
;
HDR ; --- Screen Header.
W @IOF
S ACHDPAT=$S($$DF^ACHS(0,5)="Y":$P($G(^DPT($$DF^ACHS(0,6),0)),U),1:$$DF^ACHS(0,7))
W IORVON,!?79,!
;{ABK, 4/2/10}W "CHS DEFERRED SERVICE",?28,"PATIENT: ",$E(ACHDPAT,1,25)
W "CHS UNMET NEED",?28,"PATIENT: ",$E(ACHDPAT,1,25)
W ?62,"CHART# ",$S($$DF^ACHS(0,5)="Y":$P($G(^AUPNPAT($$DF^ACHS(0,6),41,DUZ(2),0)),U,2),$$DF^ACHS(0,5)="N":$$DF^ACHS(0,12),1:"NONE")
W $J("",79-$X),!?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
Q
;
PG ; --- Page Display
S ACHDFDP=$G(^ACHSDEF(DUZ(2),"D",ACHSA,100))
W "DATE ISSUED: ",$$FMTE^XLFDT($$DF^ACHS(0,2))
;W ?45,"ISSUED BY: ",$E($P($G(^VA(200,$$DF^ACHS(0,3),0)),U),1,25),!;IHS/SET/GTH ACHS*3.1*5 12/06/2002
W ?45,"ISSUED BY: ",$E($$GET1^DIQ(200,$$DF^ACHS(0,3),.01),1,25),! ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
W !,"1. DATE OF REQUEST: ",IORVON,$$FMTE^XLFDT($$DF^ACHS(0,4)),IORVOFF
W ?45,"2. TYPE: ",IORVON,$$EXTSET^XBFUNC(9002066.01,110,$P(ACHDFDP,U,2)),IORVOFF
W !!,"3. CATEGORY: ",IORVON," ",$P($G(^ACHSDFC($P(ACHDFDP,U),0)),U)," ",IORVOFF
W !!,"4. SUB-CATEGORY: ",IORVON,$P($G(^ACHSDFC($P(ACHDFDP,U),1,$P(ACHDFDP,U,4),0)),U)," ",IORVOFF
W !!,"5. UNITS OF SERVICE: ",IORVON," ",$P(ACHDFDP,U,3)," ",IORVOFF
W !!,"6.*DIAGNOSIS / PROCEDURE: ",IORVON,$S($O(^ACHSDEF(DUZ(2),"D",ACHSA,200,0)):" ICD9",1:""),$S($O(^ACHSDEF(DUZ(2),"D",ACHSA,300,0)):" CPT",1:""),IORVOFF
;{ABK, 4/2/10}W !!,"7.*DEFERRED SVC COMMENT: ",IORVON,$S($D(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
W !!,"7.*UNMET NEED COMMENT: ",IORVON,$S($D(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
W !!,IORVON," * ",IORVOFF," - CHOOSE THESE TO SEE FURTHER INFORMATION"
S %=$$DIR^ACHS("LO^1:7","Enter Number Of Field To Edit or <RETURN> To Accept","","","",1)
I %="" S ACHDONE=1 Q
Q:$D(DUOUT)!$D(DTOUT)
I Y]"" D @(+Y)
Q
;
1 ; --- Request Date.
D DIE(4)
Q
;
2 ; --- Type of Service.
D DIE(110)
Q
;
3 ; --- Deferred Service Category.
D DIE(100)
Q
;
4 ; --- Deferred Service Sub Category.
N DIC
S DIC="^ACHSDFC("_$P(ACHDFDP,U)_",1,"
S DIC(0)="A"
S DIC("B")=$P(ACHDFDP,U,4)
D ^DIC
Q:Y<1
S DIE="^ACHSDEF("_DUZ(2)_",""D"","
S DA(1)=DUZ(2)
S DA=ACHSA
S DR="105////"_+Y
D ^DIE
K DA,DIC,DIE
Q
;
5 ; --- Units of Service.
D DIE(120)
Q
;
6 ; --- Diagnosis / Procedure.
D:$O(^ACHSDEF(DUZ(2),"D",ACHSA,200,0))!($P(ACHDFDP,U,2)="I") DIE(200)
D:$O(^ACHSDEF(DUZ(2),"D",ACHSA,300,0))!($P(ACHDFDP,U,2)="O") DIE(300)
Q
;
7 ; --- Deferred Service Comment.
D DIE(400)
Q
;
DIE(DR) ; --- Edit items in Deferred Service
W !!
S DIE="^ACHSDEF("_DUZ(2)_",""D"","
S DA(1)=DUZ(2)
S DA=ACHSA
D ^DIE
K DA,DIE
Q
;
ACHSDFDP ; IHS/ITSC/PMF - DEFERRED SERVICES DISPLAY/EDIT ; [ 12/06/2002 10:36 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
+3 ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+4 IF '$DATA(ACHSA)
QUIT
+5 IF '$DATA(^ACHSDEF(DUZ(2),0))
QUIT
+6 IF '$DATA(^ACHSDEF(DUZ(2),"D",ACHSA,0))
QUIT
+7 DO VIDEO^ACHS
+8 IF '$DATA(IORVON)
SET IORVON=""
+9 IF '$DATA(IORVOFF)
SET IORVOFF=""
+10 ;
+11 NEW ACHDFDP
+12 FOR
DO HDR
DO PG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(ACHDONE)
QUIT
END ;
+1 QUIT
+2 ;
HDR ; --- Screen Header.
+1 WRITE @IOF
+2 SET ACHDPAT=$SELECT($$DF^ACHS(0,5)="Y":$PIECE($GET(^DPT($$DF^ACHS(0,6),0)),U),1:$$DF^ACHS(0,7))
+3 WRITE IORVON,!?79,!
+4 ;{ABK, 4/2/10}W "CHS DEFERRED SERVICE",?28,"PATIENT: ",$E(ACHDPAT,1,25)
+5 WRITE "CHS UNMET NEED",?28,"PATIENT: ",$EXTRACT(ACHDPAT,1,25)
+6 WRITE ?62,"CHART# ",$SELECT($$DF^ACHS(0,5)="Y":$PIECE($GET(^AUPNPAT($$DF^ACHS(0,6),41,DUZ(2),0)),U,2),$$DF^ACHS(0,5)="N":$$DF^ACHS(0,12),1:"NONE")
+7 WRITE $JUSTIFY("",79-$X),!?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
+8 QUIT
+9 ;
PG ; --- Page Display
+1 SET ACHDFDP=$GET(^ACHSDEF(DUZ(2),"D",ACHSA,100))
+2 WRITE "DATE ISSUED: ",$$FMTE^XLFDT($$DF^ACHS(0,2))
+3 ;W ?45,"ISSUED BY: ",$E($P($G(^VA(200,$$DF^ACHS(0,3),0)),U),1,25),!;IHS/SET/GTH ACHS*3.1*5 12/06/2002
+4 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
WRITE ?45,"ISSUED BY: ",$EXTRACT($$GET1^DIQ(200,$$DF^ACHS(0,3),.01),1,25),!
+5 WRITE !,"1. DATE OF REQUEST: ",IORVON,$$FMTE^XLFDT($$DF^ACHS(0,4)),IORVOFF
+6 WRITE ?45,"2. TYPE: ",IORVON,$$EXTSET^XBFUNC(9002066.01,110,$PIECE(ACHDFDP,U,2)),IORVOFF
+7 WRITE !!,"3. CATEGORY: ",IORVON," ",$PIECE($GET(^ACHSDFC($PIECE(ACHDFDP,U),0)),U)," ",IORVOFF
+8 WRITE !!,"4. SUB-CATEGORY: ",IORVON,$PIECE($GET(^ACHSDFC($PIECE(ACHDFDP,U),1,$PIECE(ACHDFDP,U,4),0)),U)," ",IORVOFF
+9 WRITE !!,"5. UNITS OF SERVICE: ",IORVON," ",$PIECE(ACHDFDP,U,3)," ",IORVOFF
+10 WRITE !!,"6.*DIAGNOSIS / PROCEDURE: ",IORVON,$SELECT($ORDER(^ACHSDEF(DUZ(2),"D",ACHSA,200,0)):" ICD9",1:""),$SELECT($ORDER(^ACHSDEF(DUZ(2),"D",ACHSA,300,0)):" CPT",1:""),IORVOFF
+11 ;{ABK, 4/2/10}W !!,"7.*DEFERRED SVC COMMENT: ",IORVON,$S($D(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
+12 WRITE !!,"7.*UNMET NEED COMMENT: ",IORVON,$SELECT($DATA(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
+13 WRITE !!,IORVON," * ",IORVOFF," - CHOOSE THESE TO SEE FURTHER INFORMATION"
+14 SET %=$$DIR^ACHS("LO^1:7","Enter Number Of Field To Edit or <RETURN> To Accept","","","",1)
+15 IF %=""
SET ACHDONE=1
QUIT
+16 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+17 IF Y]""
DO @(+Y)
+18 QUIT
+19 ;
1 ; --- Request Date.
+1 DO DIE(4)
+2 QUIT
+3 ;
2 ; --- Type of Service.
+1 DO DIE(110)
+2 QUIT
+3 ;
3 ; --- Deferred Service Category.
+1 DO DIE(100)
+2 QUIT
+3 ;
4 ; --- Deferred Service Sub Category.
+1 NEW DIC
+2 SET DIC="^ACHSDFC("_$PIECE(ACHDFDP,U)_",1,"
+3 SET DIC(0)="A"
+4 SET DIC("B")=$PIECE(ACHDFDP,U,4)
+5 DO ^DIC
+6 IF Y<1
QUIT
+7 SET DIE="^ACHSDEF("_DUZ(2)_",""D"","
+8 SET DA(1)=DUZ(2)
+9 SET DA=ACHSA
+10 SET DR="105////"_+Y
+11 DO ^DIE
+12 KILL DA,DIC,DIE
+13 QUIT
+14 ;
5 ; --- Units of Service.
+1 DO DIE(120)
+2 QUIT
+3 ;
6 ; --- Diagnosis / Procedure.
+1 IF $ORDER(^ACHSDEF(DUZ(2),"D",ACHSA,200,0))!($PIECE(ACHDFDP,U,2)="I")
DO DIE(200)
+2 IF $ORDER(^ACHSDEF(DUZ(2),"D",ACHSA,300,0))!($PIECE(ACHDFDP,U,2)="O")
DO DIE(300)
+3 QUIT
+4 ;
7 ; --- Deferred Service Comment.
+1 DO DIE(400)
+2 QUIT
+3 ;
DIE(DR) ; --- Edit items in Deferred Service
+1 WRITE !!
+2 SET DIE="^ACHSDEF("_DUZ(2)_",""D"","
+3 SET DA(1)=DUZ(2)
+4 SET DA=ACHSA
+5 DO ^DIE
+6 KILL DA,DIE
+7 QUIT
+8 ;
