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

SDACSCG.m

Go to the documentation of this file. 
  1. SDACSCG ;ALB/TET - Print/Edit Computer Generated Appt Types ;3/18/92  14:18
  1.  ;;5.3;Scheduling;**16,22,132,202,721**;Aug 13, 1993;Build 11
  1.  ;
  1.  Q
  1. CK ; -- check the number of computer generated visits
  1.  N SDT,SDOE,CT
  1.  S (SDT,CT)=0
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  S CT=CT+1
  1.  ;
  1.  I CT D
  1.  . W !?5,"There are ",CT," encounter(s) with a 'Computer Generated' appointment type.",*7,!
  1.  E  D
  1.  . W !?5,"There are no 'Computer Generated' appointment type encounters."
  1.  Q
  1.  ;
  1. PRINT ;print those CG types which need to be manually updated
  1.  S DGPGM="QUE^SDACSCG"
  1.  D ZIS^DGUTQ
  1.  Q:POP
  1.  ;
  1. QUE ; -- queue entry point
  1.  N SDOE,SDOE0,SDT,DSAH,SDY,CT,Y,X,VA,VADM,VAERR,CT,%DT
  1.  S DASH="",$P(DASH,"-",79)=""
  1.  S (SDT,CT)=0,%DT="SX"
  1.  D HDR
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D  G:$D(DTOUT)!($D(DUOUT)) EXIT
  1.  . S Y=SDT D DD^%DT S SDY=Y
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:$D(DTOUT)!($D(DUOUT))
  1.  . . S SDOE0=$G(^SCE(SDOE,0))
  1.  . . S DFN=+$P(SDOE0,U,2)
  1.  . . D DEM^VADPT
  1.  . . D:$Y+6>IOSL CR,HDR
  1.  . . Q:$D(DTOUT)!($D(DUOUT))
  1.  . . W !,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,$G(VA("PID")) ;SD*5.3*721 - Protect VA("PID") variable
  1.  . . S CT=CT+1
  1.  I CT D:$Y+4>IOSL CR W !!,CT," MATCHES FOUND.",!
  1.  ;
  1. EXIT ; -- exit processing
  1.  K %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ
  1.  K DR,DTOUT,DUOUT,FR,I,J,POP,SDA,SDAPTYP,SDBEG,SDCSNODE
  1.  K SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL,VAERR,VA,X,Y
  1.  Q
  1.  ;
  1. CR ; -- end of page processing
  1.  Q:$E(IOST,1,2)'="C-"
  1.  W !!,"Press RETURN to continue or '^' to exit: "
  1.  R SDXX:DTIME S:'$T DTOUT=1
  1.  Q:$D(DTOUT)!(SDXX="")
  1.  I SDXX="^" S DUOUT=1 Q
  1.  W !?5,"Enter an '^' to exit the listing, or enter RETURN to continue."
  1.  G CR
  1.  ;
  1. HDR ; -- header processing
  1.  W:$D(IOF) @IOF W !,"COMPUTER GENERATED APPOINTMENT TYPES"
  1.  W !,"ENCOUNTER DATE/TIME",?25,"PATIENT",?60,"PT ID",!,DASH,!!
  1.  Q
  1.  ;
  1. EDIT ; -- edit computer generated appt types
  1.  N DIR,SDOUT,%DT
  1.  I '$O(^SCE("ACG",0)) W !!?5,"There are no 'Computer Generated' Appointment Types which need updating." G EDITQ
  1.  ;
  1.  W !
  1.  S DIR("A",1)="You may enter one of the following:"
  1.  S DIR("A",2)="         Encounter Date - edit 'Computer Generated' entries for a specific date"
  1.  S DIR("A",3)="  Patient Name (or SSN) - edit 'Computer Generated' entries for one patient"
  1.  S DIR("A",4)="  The default of 'ALL'  - edit all entries which are 'Computer Generated'"
  1.  S DIR("A")="Select Encounter Date"
  1.  S DIR("B")="ALL"
  1.  S DIR(0)="F^1:30"
  1.  S %DT(0)="-DT"
  1.  S DIR("?")="^D QUE^SDACSCG"
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) EDITQ
  1.  ;
  1.  S SDOUT=0
  1.  D
  1.  .N SDZ
  1.  .I "ALLall"[Y D  Q
  1.  ..D ALL
  1.  .S (X,SDZ)=Y,%DT="PX"
  1.  .D ^%DT
  1.  .I Y'=-1 D  Q
  1.  ..S Y=SDZ
  1.  ..D DATE
  1.  .S Y=SDZ
  1.  .I Y?9N!(Y?1A4N)!(Y?.AP)!(Y?4N) D  Q
  1.  ..D DPT
  1.  ;
  1.  I 'SDOUT G EDIT
  1.  ;
  1. EDITQ D EXIT
  1.  Q
  1.  ;
  1. DATE ;
  1.  N CT,%DT,Y,SDBEG,SDEND
  1.  S CT=0
  1.  S %DT="EPTXS"
  1.  S %DT(0)=-DT
  1.  D ^%DT S Y=+Y
  1.  IF $D(DTOUT) S SDOUT=1 G DATEQ
  1.  G DATEQ:Y=-1
  1.  ;
  1.  S SDBEG=$S(Y[".":Y-.000001,1:Y)
  1.  S SDEND=$S(Y[".":Y,1:Y_.999999)
  1.  D LOOP(SDBEG,SDEND)
  1.  ;
  1.  G:SDOUT DATEQ
  1.  W:'CT !,"There are no 'Computer Generated' appt types for selection.",*7,!
  1. DATEQ Q
  1.  ;
  1. ALL ; -- loop through and edit all computer generated appt types
  1.  N CT
  1.  S CT=0
  1.  ;
  1.  D LOOP()
  1.  ;
  1. ALLQ Q
  1.  ;
  1. DPT ; -- look up in patient file & loop through acg for selected dfn
  1.  ;
  1.  N DIC,D,CT,Y
  1.  S CT=0
  1.  S DIC="^DPT(",DIC(0)="EQMZ"
  1.  S D=$S(X?9N:"SSN",X?1A.4N:"B5",1:"B")
  1.  D IX^DIC
  1.  G DPTQ:Y'>0
  1.  ;
  1.  D LOOP(,,+Y)
  1.  ;
  1.  G:SDOUT DPTQ
  1.  W:'CT !,"There are no 'Computer Generated' appt types for selected entry.",*7,!
  1. DPTQ Q
  1.  ;
  1. LOOP(SDBEG,SDEND,SDFN) ;
  1.  N SDY,DFN,VA,VAERR,VAADM,SDT,SDOE,SDCLIN,SDSTOP,SDDIV,SDSTA,SDPAT,SDDT,SDCELIG
  1.  ;
  1.  IF '$G(SDBEG) N SDBEG S SDBEG=0
  1.  IF '$G(SDEND) N SDEND S SDEND=9999999
  1.  IF '$G(SDFN) N SDFN S SDFN=0
  1.  ;
  1.  S SDT=SDBEG
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT!(SDT>SDEND)  D  Q:SDOUT
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:SDOUT 
  1.  . . IF SDFN,SDFN'=+$P($G(^SCE(SDOE,0)),"^",2) Q
  1.  . . S SDPAT=+$P($G(^SCE(SDOE,0)),"^",2) Q:'SDPAT  ;SD*721 - Quit if no patient info in encounter
  1.  . . S SDDT=$P(+$P($G(^SCE(SDOE,0)),U),".") Q:'SDDT  ;SD*721 - Quit if not valid date
  1.  . . Q:$G(^DPT(SDPAT,0))=""  ;SD*721 - Quit if not in Patient File, supported by ICR #10035
  1.  . . S SDCELIG=$$GET1^DIQ(409.68,SDOE,.13)  ;SD*721 - Get Current Eligibility
  1.  . . S SDCLIN=$$GET1^DIQ(409.68,SDOE,.04),SDSTOP=$$GET1^DIQ(409.68,SDOE,.03)
  1.  . . ;Reference to SITE^VASITE supported by ICR #10112
  1.  . . S SDDIV=$$GET1^DIQ(409.68,SDOE,.11,"I"),SDSTA=$P($$SITE^VASITE(SDDT,SDDIV),U,3)
  1.  . . D DEM(SDOE),DEMW
  1.  . . D DIE(SDOE)
  1. LOOPQ Q
  1.  ;
  1. DEM(SDOE) ; -- get pt name,ssn and visit date
  1.  N SDOE0,Y,DFN
  1.  S SDOE0=$G(^SCE(SDOE,0))
  1.  S DFN=+$P(SDOE0,"^",2)
  1.  D DEM^VADPT
  1.  S Y=+SDOE0 D DD^%DT S SDY=Y
  1.  Q
  1.  ;
  1. DEMW ; -- write patient demographics
  1.  ;SD*721 - Add header, division, location, stop code, and service connected information
  1.  N SDHASH
  1.  W @IOF,"ENCOUNTER DATE",?25,"PATIENT NAME",?60,"PATIENT SSN" ;Header - SD*721
  1.  W !,?3,"DIVISION",?15,"CLINIC LOCATION",?50,"STOP CODE" ;Header - SD*721
  1.  W ! F SDHASH=1:1:80 W "-" ;Header - SD*721
  1.  W !,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,$G(VA("PID")) ;SD*5.3*721 - Protect VA("PID") variable
  1.  W !,?3,SDSTA,?15,$S(SDCLIN'="":SDCLIN,1:"UNKNOWN LOCATION"),?50,SDSTOP ;SD*721 - division, location, stop code
  1.  D SC(SDPAT) ;SD*721 - Service connected info
  1.  K VAEL,DFN
  1.  Q
  1.  ;
  1. DIE(SDOE) ; -- do edit
  1.  N DR,DIE,DE,DQ
  1.  S DR=".1d;I $P(^(0),U,10)=10 S Y=""@99"";202///@;@99"
  1.  S DIE="^SCE("
  1.  S DA=SDOE
  1.  D ^DIE
  1.  S:$D(DTOUT)!($D(Y)'=0) SDOUT=1
  1.  S CT=CT+1
  1.  Q
  1.  ;
  1. SC(DFN) ;SD*721 - Add Service Connected Information
  1.  ; Input  -- DFN      Patient file IEN
  1.  N SDI,SDCNT,SDDC,SDRD0,SDARR,SDSECN
  1.  ;Reference to ELIG^VADPT supported by ICR #10061
  1.  D ELIG^VADPT
  1.  W !!,"Patient's Service Connection and Rated Disabilities:"
  1.  W !!,$S(+VAEL(3)="1":"        SC Percent: "_$P(VAEL(3),U,2)_"%",1:" Service Connected: No")
  1.  W !,"Rated Disabilities: "
  1.  I 'VAEL(4) W "Not a Veteran",!,"Primary Eligibility Code: ",$S(+VAEL(1):$P(VAEL(1),U,2),1:"N/A") D  W !!,"Current Eligibility for Encounter: ",$S(SDCELIG'="":SDCELIG,1:"N/A") Q
  1.  .S SDSECN=0 F  S SDSECN=$O(VAEL(1,SDSECN)) Q:'SDSECN  W !,"Secondary Eligibility Code: ",$P(VAEL(1,SDSECN),U,2)
  1.  S (SDCNT,SDI)=0
  1.  ;Reference to ^DPT(DFN,.372 supported by ICR #1476
  1.  F  S SDI=$O(^DPT(DFN,.372,SDI)) Q:'SDI  I $P($G(^(SDI,0)),"^",3) S SDRD0=^(0) D
  1.  .S SDCNT=SDCNT+1
  1.  .;Reference to ^DIC(31,+SDRD0 supported by ICR #733
  1.  .S SDDC=$P($G(^DIC(31,+SDRD0,0)),U)
  1.  .W:SDCNT>1 !
  1.  .W ?20,SDDC,"  (",$P(SDRD0,"^",2),"%-",$S($P(SDRD0,"^",3):"SC",1:""),")"
  1.  I 'SDCNT W $S('$O(^DPT(DFN,.372,0)):"None Stated",1:"No Service Connected Disabilities Listed")
  1.  W !,"Primary Eligibility Code: ",$S(+VAEL(1):$P(VAEL(1),U,2),1:"N/A") D
  1.  .S SDSECN=0 F  S SDSECN=$O(VAEL(1,SDSECN)) Q:'SDSECN  W !,"Secondary Eligibility Code: ",$P(VAEL(1,SDSECN),U,2)
  1.  W !!,"Current Eligibility for Encounter: ",$S(SDCELIG'="":SDCELIG,1:"N/A")
  1.  Q