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

ACKQNQ.m

Go to the documentation of this file.
  1. ACKQNQ ;AUG/JLTP,AEM BIR/PTD HCIOFO/BH HCIOFO/AG - Inquire - A&SP Patient ;18 Jun 2013 10:09 AM
  1. ;;3.0;QUASAR;**8,14,18,22,21**;Feb 11, 2000;Build 40
  1. ;
  1. ; Reference/IA
  1. ; $$CSI^ICDEX - 5747
  1. ;
  1. OPTN ; Introduce option.
  1. S ACKQUIT=0
  1. W:$E(IOST,1,2)="C-" @IOF,!,"This option displays demographic data, inpatient status, and diagnostic",!,"history for a selected A&SP patient."
  1. ;
  1. DIC ; LOOKUP PATIENT
  1. N DIC
  1. W ! S DIC=509850.2,DIC(0)="AEMQ" D ^DIC
  1. I (Y<0)!($D(DUOUT)) S ACKQUIT=1 G EXIT
  1. S ACKDFN=+Y
  1. ;
  1. ASK ; Update patient's diagnostic history?
  1. S DIR(0)="Y",DIR("A")="Do you want to update this patient's diagnostic history NOW",DIR("B")="NO",DIR("?")="Enter YES to recompile the Problem List; enter NO to continue."
  1. S DIR("??")="^D UPDATE^ACKQHLP1" W ! D ^DIR K DIR G:$D(DIRUT) EXIT I Y=1 D UPDATE
  1. ;
  1. DEV W !!,"The right margin for this report is 80.",!,"You can queue it to run at a later time.",!
  1. K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
  1. I $D(IO("Q")) K IO("Q") S ZTRTN="EN^ACKQNQ",ZTSAVE("ACKDFN")="",ZTDESC="QUASAR - Inquire - A&SP Patient" D ^%ZTLOAD D HOME^%ZIS K ZTSK G EXIT
  1. ;
  1. EN U IO N DFN,I,X,Y S DFN=ACKDFN
  1. D DEM^VADPT,INP^VADPT,ELIG^VADPT
  1. S ACKIVD=$$NUMDT^ACKQUTL($P(^ACK(509850.2,DFN,0),U,2))
  1. K ACK S ACK(1)=VADM(1),ACK(2)=$P(VADM(3),U,2),ACK(3)=$P(VADM(2),U,2),ACK(4)=VADM(7),ACK(6)=$P(VAIN(4),U,2)
  1. S ACKINP=$S($L(ACK(6)):1,1:0),ACK(5)="Patient is "_$S(ACKINP:"",1:"not ")_"currently an inpatient."
  1. S ACK(7)=VAIN(5),ACK(8)=$P(VAIN(3),U,2),ACK(9)=$P(VAEL(1),U,2)
  1. ;
  1. ;
  1. PRINT W:$E(IOST,1,2)="C-" @IOF
  1. D CNTR^ACKQUTL("Patient Inquiry")
  1. ;
  1. W !!
  1. W "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)
  1. W !,"ELIGIBILITY: ",ACK(9)
  1. W ?45,"INITIAL VISIT DATE: ",ACKIVD
  1. W:$L(ACK(4)) !,ACK(4) W !,ACK(5) D:ACKINP INP
  1. ;
  1. I $P(VAEL(3),U,1) W !!,"Patient is Service Connected."
  1. I '$P(VAEL(3),U,1) D
  1. . S ACKPAT=DFN D STATUS^ACKQUTL4 K VASV
  1. . D NOT^ACKQUTL7("Patient is not Service Connected.",ACKAO,ACKRAD,ACKENV)
  1. . K ACKPAT,ACKAO,ACKRAD,ACKENV
  1. ;
  1. D RATDIS G:$G(DIRUT) EXIT
  1. D ICDSORT,DIAGHIST
  1. ;
  1. EXIT I $G(ACKVISIT)'="",$G(DIRUT)=1 S ACKDIRUT=1 ; Quit flag for template
  1. K %ZIS,ACK,ACKCDST,ACKDATE,ACKDC,ACKDD,ACKDESC,ACKDFN,ACKDN,ACKDX
  1. K ACKI,ACKICD,ACKICDX,ACKINFO,ACKINP,ACKIVD,ACKLINE,ACKQECON,ACKQIR,ACKQORG
  1. K ACKRD,ACKQSER,CNTR0,CNTR9,DATA,DIRUT,DTOUT,DUOUT,IOUOFF,IOUON,POP
  1. K VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
  1. I $G(ACKQUIT)=1 D KILL^%ZISS Q
  1. I $E(IOST,1,2)="C-" W !!,"Press return to continue." R X:DTIME W @IOF
  1. D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. S ACKQUIT=0 G DIC
  1. Q
  1. ;
  1. EN1 ; CALL THIS ENTRY POINT INSTEAD OF EN
  1. D HOME^%ZIS G EN
  1. ;
  1. ;
  1. INP ; PRINT INPATIENT INFO
  1. W !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC: ",$E(ACK(8),1,25)
  1. Q
  1. ;
  1. ;
  1. RATDIS ; Display Patients RATED DISABILITIES
  1. Q:'$O(^DPT(DFN,.372,0))
  1. N ACKRD,RC,X,X1
  1. D ENS^%ZISS
  1. ;---
  1. S RC=$$PAGE(5) Q:RC<0 W:'RC !!
  1. W IOUON,"Rated Disabilities",IOUOFF,!
  1. ;---
  1. S ACKRD=0
  1. F S ACKRD=$O(^DPT(DFN,.372,ACKRD)) Q:'ACKRD D Q:RC<0
  1. . S RC=$$PAGE(2) Q:RC<0
  1. . W:RC IOUON,"Rated Disabilities (cont'd)",IOUOFF,!
  1. . S X=^DPT(DFN,.372,ACKRD,0),X1=$P(^DIC(31,+X,0),U)
  1. . W !,X1_" ("_$P(X,U,2)_"%)" I $P(X,U,3) W " (SC)"
  1. Q
  1. ;
  1. DIAGHIST ;
  1. Q:$D(ACKICD)<10
  1. N ACKI,ACKICD0,ACKICD9,RC
  1. D ENS^%ZISS
  1. ;---
  1. S RC=$$PAGE(7) Q:RC<0 W:'RC !!
  1. W IOUON,"Patient Diagnostic History",IOUOFF
  1. W !,$S($P(VADM(5),U)="F":"Ms. ",1:"Mr. "),$P(VADM(1),",")," has been seen for the following:",!
  1. D DIHEAD
  1. ;---
  1. S ACKI=""
  1. S ACKICDX=""
  1. F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D Q:RC<0
  1. . S RC=$$PAGE(2) Q:RC<0
  1. . I RC D D DIHEAD
  1. . . W IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,!
  1. . S ACKICDX=""
  1. . S ACKICDX=$O(ACKICD(ACKI,ACKICDX))
  1. . S ACKCDST(ACKICDX)=ACKICDX
  1. I $D(ACKCDST(1)),$D(ACKCDST(30)) D
  1. . S ACKI="",CNTR9=0,CNTR0=0
  1. . F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D
  1. . . S ACKICD=""
  1. . . F S ACKICD=$O(ACKICD(ACKI,ACKICD)) Q:ACKICD="" D
  1. . . . S ACKDX=$P(ACKICD(ACKI,ACKICD),U)
  1. . . . S ACKDESC=$P(ACKICD(ACKI,ACKICD),U,3)
  1. . . . S ACKDATE=$$NUMDT^ACKQUTL($P(ACKICD(ACKI,ACKICD),U,4))
  1. . . . I ACKICD=1 S CNTR9=CNTR9+1 S ACKICD9(CNTR9)=ACKDX_U_ACKDESC_U_ACKDATE
  1. . . . I ACKICD=30 S CNTR0=CNTR0+1 S ACKICD0(CNTR0)=ACKDX_U_ACKDESC_U_ACKDATE
  1. . D PRTHEAD,EXIT Q
  1. S ACKI="" F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D Q:RC<0
  1. . S RC=$$PAGE(2) Q:RC<0
  1. . I RC D D DIHEAD
  1. . . W IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,! Q
  1. . S ACKICDX=""
  1. . S ACKICDX=$O(ACKICD(ACKI,ACKICDX)) D
  1. . . W !,$P(ACKICD(ACKI,ACKICDX),U),?15,$P(ACKICD(ACKI,ACKICDX),U,3),?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI,ACKICDX),U,4))
  1. Q
  1. ;
  1. CLASDIS ; Display Patient Servive Classifications
  1. N RC
  1. I '$D(ACKQSER),'$D(ACKQORG),'$D(ACKQIR),'$D(ACKQECON) Q
  1. S RC=$$PAGE(5) Q:RC<0 W:'RC !!
  1. D ENS^%ZISS
  1. W IOUON,"Service Classifications",IOUOFF,!
  1. W:$D(ACKQSER) " SERVICE-CONNECTED " W:$D(ACKQORG) " AGENT-ORANGE " W:$D(ACKQIR) " RADIATION " W:$D(ACKQECON) " ENVIRONMENTAL-CONTAMINANTS"
  1. W !
  1. Q
  1. ;
  1. ;
  1. DIHEAD W !,"DIAGNOSIS",?60,"DATE ENTERED",!,$$REPEAT^XLFSTR("-",IOM-1)
  1. Q
  1. ;
  1. ;
  1. ICDSORT ;
  1. S ACKI=0 F S ACKI=$O(^ACK(509850.2,DFN,1,ACKI)) Q:'ACKI D
  1. . S ACKDC=^ACK(509850.2,DFN,1,ACKI,0),ACKDD=$P(ACKDC,U,2)
  1. . S ACKICD=$$CSI^ICDEX(80,+ACKDC) ; returns 1 for ICD9 and 30 for ICD10
  1. . S ACKINFO=$$ICDDATA^ICDXCODE(ACKICD,+ACKDC,ACKDD,"I")
  1. . S ACKTGT=$P(ACKINFO,U,3)
  1. . S ACKDN=$P(ACKINFO,U,2)
  1. . S ACKICD(ACKDN,ACKICD)=ACKDN_U_ACKTGT_U_$$DIAGTXT^ACKQUTL8(+ACKDC,ACKDD)_U_ACKDD
  1. K ACKTGT,ACKMSG
  1. Q
  1. ;
  1. UPDATE ; Update patient's diagnostic history in 509850.2.
  1. ; ACKDFN is defined upon entry to this module.
  1. D WAIT^DICD W !
  1. D PROBLIST^ACKQUTL3(ACKDFN,1)
  1. Q
  1. ;
  1. ;***** CHECKS IS NEW PAGE SHOULD BE STARTED
  1. ;
  1. ; [RESERVE] Number of additional reserved lines (0, by default).
  1. ; If the current page does not have so many lines
  1. ; available, a new page will be started.
  1. ;
  1. ; [FORCE] Force the prompt
  1. ;
  1. ; Return values:
  1. ;
  1. ; -2 Timeout
  1. ; -1 User canceled the output ('^' was entered)
  1. ; 0 Ok
  1. ; 1 New page
  1. ;
  1. PAGE(RESERVE,FORCE) ;
  1. N RC
  1. I ($Y'<($G(IOSL,24)-$G(RESERVE,1)))!$G(FORCE) D S $Y=0
  1. . I $E(IOST,1,2)'="C-" W @IOF Q
  1. . N DA,DIR,DIROUT,DTOUT,DUOUT,I,X,Y
  1. . S DIR(0)="E"
  1. . D ^DIR
  1. . S RC=$S($D(DUOUT):-1,$D(DTOUT):-2,1:1)
  1. . W:RC>0 @IOF
  1. Q +$G(RC)
  1. ;
  1. PRTHEAD ;
  1. S CNTR9=0,CNTR0=0
  1. W !,"ICD-9-CM",!
  1. F CNTR9=1:1 S DATA=$G(ACKICD9(CNTR9)) Q:'$D(ACKICD9(CNTR9)) D
  1. . S ACKDX=$P(DATA,U)
  1. . S ACKDESC=$P(DATA,U,2)
  1. . S ACKDATE=$P(DATA,U,3)
  1. . K ACKICDDS,ACKARNUM S ACKICDDS=ACKDESC D BRKDESC^ACKQR3(40)
  1. . ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
  1. . W !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
  1. . F ACKARNM2=2:1:ACKARNUM W !?15,ACKICDDS(ACKARNM2)
  1. . K ACKICDDS,ACKARNUM,ACKARNM2
  1. W !!,"ICD-10-CM",!
  1. F CNTR0=1:1 S DATA=$G(ACKICD0(CNTR0)) Q:'$D(ACKICD0(CNTR0)) D
  1. . S ACKDX=$P(DATA,U)
  1. . S ACKDESC=$P(DATA,U,2)
  1. . S ACKDATE=$P(DATA,U,3)
  1. . K ACKICDDS,ACKARNUM S ACKICDDS=ACKDESC D BRKDESC^ACKQR3(40)
  1. . ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
  1. . W !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
  1. . F ACKARNM2=2:1:ACKARNUM W !?15,ACKICDDS(ACKARNM2)
  1. . K ACKICDDS,ACKARNUM,ACKARNM2
  1. Q
  1. ;