Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSDFDP

ACHSDFDP.m

Go to the documentation of this file. 
  1. 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
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
  1.  ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
  1.  Q:'$D(ACHSA)
  1.  Q:'$D(^ACHSDEF(DUZ(2),0))
  1.  Q:'$D(^ACHSDEF(DUZ(2),"D",ACHSA,0))
  1.  D VIDEO^ACHS
  1.  S:'$D(IORVON) IORVON=""
  1.  S:'$D(IORVOFF) IORVOFF=""
  1.  ;
  1.  N ACHDFDP
  1.  F  D HDR,PG Q:$D(DUOUT)!$D(DTOUT)!$D(ACHDONE)
  1. END ;
  1.  Q
  1.  ;
  1. HDR ; --- Screen Header.
  1.  W @IOF
  1.  S ACHDPAT=$S($$DF^ACHS(0,5)="Y":$P($G(^DPT($$DF^ACHS(0,6),0)),U),1:$$DF^ACHS(0,7))
  1.  W IORVON,!?79,!
  1.  ;{ABK, 4/2/10}W "CHS DEFERRED SERVICE",?28,"PATIENT: ",$E(ACHDPAT,1,25)
  1.  W "CHS UNMET NEED",?28,"PATIENT: ",$E(ACHDPAT,1,25)
  1.  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")
  1.  W $J("",79-$X),!?79,IORVOFF,!,$$REPEAT^XLFSTR("=",79),!
  1.  Q
  1.  ;
  1. PG ; --- Page Display
  1.  S ACHDFDP=$G(^ACHSDEF(DUZ(2),"D",ACHSA,100))
  1.  W "DATE ISSUED: ",$$FMTE^XLFDT($$DF^ACHS(0,2))
  1.  ;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
  1.  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
  1.  W !,"1. DATE OF REQUEST: ",IORVON,$$FMTE^XLFDT($$DF^ACHS(0,4)),IORVOFF
  1.  W ?45,"2. TYPE: ",IORVON,$$EXTSET^XBFUNC(9002066.01,110,$P(ACHDFDP,U,2)),IORVOFF
  1.  W !!,"3. CATEGORY: ",IORVON," ",$P($G(^ACHSDFC($P(ACHDFDP,U),0)),U)," ",IORVOFF
  1.  W !!,"4. SUB-CATEGORY: ",IORVON,$P($G(^ACHSDFC($P(ACHDFDP,U),1,$P(ACHDFDP,U,4),0)),U)," ",IORVOFF
  1.  W !!,"5. UNITS OF SERVICE: ",IORVON," ",$P(ACHDFDP,U,3)," ",IORVOFF
  1.  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
  1.  ;{ABK, 4/2/10}W !!,"7.*DEFERRED SVC COMMENT: ",IORVON,$S($D(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
  1.  W !!,"7.*UNMET NEED COMMENT: ",IORVON,$S($D(^ACHSDEF(DUZ(2),"D",ACHSA,400,0)):"YES",1:"NONE"),IORVOFF
  1.  W !!,IORVON," * ",IORVOFF," - CHOOSE THESE TO SEE FURTHER INFORMATION"
  1.  S %=$$DIR^ACHS("LO^1:7","Enter Number Of Field To Edit or <RETURN> To Accept","","","",1)
  1.  I %="" S ACHDONE=1 Q
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  I Y]"" D @(+Y)
  1.  Q
  1.  ;
  1. 1 ; --- Request Date.
  1.  D DIE(4)
  1.  Q
  1.  ;
  1. 2 ; --- Type of Service.
  1.  D DIE(110)
  1.  Q
  1.  ;
  1. 3 ; --- Deferred Service Category.
  1.  D DIE(100)
  1.  Q
  1.  ;
  1. 4 ; --- Deferred Service Sub Category.
  1.  N DIC
  1.  S DIC="^ACHSDFC("_$P(ACHDFDP,U)_",1,"
  1.  S DIC(0)="A"
  1.  S DIC("B")=$P(ACHDFDP,U,4)
  1.  D ^DIC
  1.  Q:Y<1
  1.  S DIE="^ACHSDEF("_DUZ(2)_",""D"","
  1.  S DA(1)=DUZ(2)
  1.  S DA=ACHSA
  1.  S DR="105////"_+Y
  1.  D ^DIE
  1.  K DA,DIC,DIE
  1.  Q
  1.  ;
  1. 5 ; --- Units of Service.
  1.  D DIE(120)
  1.  Q
  1.  ;
  1. 6 ; --- Diagnosis / Procedure.
  1.  D:$O(^ACHSDEF(DUZ(2),"D",ACHSA,200,0))!($P(ACHDFDP,U,2)="I") DIE(200)
  1.  D:$O(^ACHSDEF(DUZ(2),"D",ACHSA,300,0))!($P(ACHDFDP,U,2)="O") DIE(300)
  1.  Q
  1.  ;
  1. 7 ; --- Deferred Service Comment.
  1.  D DIE(400)
  1.  Q
  1.  ;
  1. DIE(DR) ; --- Edit items in Deferred Service
  1.  W !!
  1.  S DIE="^ACHSDEF("_DUZ(2)_",""D"","
  1.  S DA(1)=DUZ(2)
  1.  S DA=ACHSA
  1.  D ^DIE
  1.  K DA,DIE
  1.  Q
  1.  ;