ACMLCMS ; IHS/TUCSON/TMJ - ENTRY TO SET AND DISPLAY CLIENT DATA ; [ 01/03/06 2:03 PM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,5,6**;JAN 10, 1996
;PATCH #6 FIXES INSURANCE HEADER DISPLAY AND FORMAT PROBLEMS
;EP;ENTRY POINT TO SET AND DISPLAY CLIENT DATA
LCMS D INIT,VARS
Q
;
INIT ;S ACMDOB=$P(^DPT(ACMPTNO,0),U,3),(Y,X2)=ACMDOB,X1=DT
S ACMDOB=$P(^DPT(ACMPTNO,0),U,3),(Y,X2)=ACMDOB,X1=DT,ACMPHONE=$P($G(^(.13)),U) ;IHS/CIM/THL PATCH 5
D ^%DTC
X ^DD("DD")
S ACMDOB=Y
I X>365 S ACMAGE=(X\365.25)_" YRS"
I (X>30)&(X<366) S ACMAGE=(X\30.4)_" MOS"
I X<31 S ACMAGE=X_" (DYS)"
Q
;
VARS I $D(DUZ(2))#2,DUZ(2) S ACMSRT=$S($D(^AUPNPAT(ACMPTNO,41,DUZ(2),0)):$P(^(0),U,2),1:"<NONE>")
S (ACMSTAT,ACMSEV,ACMPC,ACMINIT,ACMWHER,ACMCOMM,ACMPG)="NOT STATED",(ACMPRV,ACMMGR,ACMPHN)="NONE ASSIGNED"
S ACMDT="^ACM(41,"_ACMRGDFN_",""DT"")"
I '$D(@ACMDT) S @ACMDT="A"
S ACMDT=@ACMDT,ACMSTAT=$S($P(ACMDT,U)'="":$P(ACMDT,U),1:"NOT STATED"),ACMMGR=$S($P(ACMDT,U,6)'="":$P(ACMDT,U,6),1:"NONE ASSIGNED")
S:ACMMGR'="NONE ASSIGNED" ACMMGR=$S($D(^VA(200,ACMMGR,0)):$P(^(0),U),1:"NONE ASSIGNED")
S ACMPHN=$S($P(ACMDT,U,7)'="":$P(ACMDT,U,7),1:"NONE ASSIGNED")
S:ACMPHN'="NONE ASSIGNED" ACMPHN=$S($D(^VA(200,ACMPHN,0)):$P(^(0),U),1:"NONE ASSIGNED")
S ACMSEV=$S($P(ACMDT,U,5)'="":$P(ACMDT,U,5),1:"NOT STATED")
I $P(ACMDT,U,4)'="" S ACMINIT=$P(ACMDT,U,4) S Y=ACMINIT X ^DD("DD") S ACMINIT=Y
S ACMWHER=$S($P(ACMDT,U,10):$P(ACMDT,U,10),1:"NOT STATED")
S:ACMWHER'="NOT STATED" ACMWHER=$S($D(^AUTTLOC(ACMWHER,0)):$P(^(0),U,2),1:"NOT STATED")
S ACMPG=$S($P(ACMDT,U,13)'="":$P(ACMDT,U,13),1:"NOT STATED"),ACMPC=$S($P(ACMDT,U,14)'="":$P(ACMDT,U,14),1:"NOT STATED"),ACMPRV=$S($P(ACMDT,U,15)'="":$P(ACMDT,U,15),1:"NONE ASSIGNED")
S:ACMPRV'="NONE ASSIGNED" ACMPRV=$S($D(^VA(200,ACMPRV,0)):$P(^(0),U),1:"NONE ASSIGNED")
S ACMCOMM=$S($D(^AUPNPAT(ACMPTNO,11)):$P(^(11),U,18),1:"")
S:ACMCOMM="" ACMCOMM="NOT STATED"
K ACMDT
Q
ACMPT ;EP;TO DISPLAY PATIENT INFO
W:'$D(ACMPAGE) !?7,"CHART: ",ACMSRT
W:$D(ACMPAGE) ! ;IHS/ANMC/LJF 11/5/99 put PCP on separate line if rpt
W ?35,"PRIMARY CARE PROVIDER: ",$$VAL^XBDIQ1(9000001,ACMPTNO,.14) ;IHS/ANMC/LJF 11/5/99
W !?9,"DOB: ",?14,ACMDOB,?53,"AGE: ",ACMAGE
W !?5,"CONTACT: ",?14,$S(ACMPG'="":ACMPG,1:"NOT LISTED"),?47,"COMMUNITY: ",ACMCOMM ;IHS/CIM/THL PATCH 5
W !?46,"HOME PHONE: ",$G(ACMPHONE) ;IHS/CIM/THL PATCH 5
N APCHSPAT,APCHSCKP,APCHSNPG
S APCHSPAT=ACMPTNO
S APCHSCKP=""
S APCHSNPG=1
S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
S ACMINS=0 ;IHS/CMI/TMJ PATCH #6
I $D(^AUPNMCD("B",ACMPTNO)) S ACMINS=1
I $D(^AUPNMCR(ACMPTNO)) S ACMINS=1
I $D(^AUPNPRVT(ACMPTNO)) S ACMINS=1
I $D(^AUPNRRE(ACMPTNO)) S ACMINS=1
I ACMINS=1 W !,"************************** INSURANCE INFORMATION ***************************",!
D INS^APCHS5
W ! ;IHS/ANMC/LJF 11/5/99 separate editable from uneditable fields
W " *********************** PATIENT INFORMATION *************************",! ;IHS/CMI/TMJ PATCH #6
W ?6,"STATUS: ",$S(ACMSTAT="A":"ACTIVE",ACMSTAT="I":"INACTIVE",ACMSTAT="T":"TRANSIENT",ACMSTAT="U":"UNREVIEWED",ACMSTAT="D":"DECEASED",ACMSTAT="N":"NON-IHS",1:"NOT STATED")
;W ?44,"CASE PRIORIT: ",?14,$S(ACMSEV="L":"LOW",ACMSEV="M":"MEDIUM",ACMSEV="H":"HIGH",ACMSEV="C":"CRITICAL",1:"NOT STATED"),!,"PRIMARY PRVD: ",?14,ACMPRV
W ?44,"CASE PRIORIT: ",?58,$S(ACMSEV="L":"LOW",ACMSEV="M":"MEDIUM",ACMSEV="H":"HIGH",ACMSEV="C":"CRITICAL",1:"NOT STATED"),!,?6,"REGISTER PRV: ",?14,ACMPRV ;IHS/ANMC/LJF 11/5/99
W ?46,"INIT ENTRY: ",$S($D(ACMINIT):ACMINIT,1:"NOT STATED"),!,?6,"CASE MANAGER: ",?14,ACMMGR,?46,"WHERE FLWD: ",ACMWHER
W !,?6,"PUB HLTH NRS:",?14,$S($D(ACMPHN):ACMPHN,1:"NONE ASSIGNED")
I $D(ACMPAGE)&(IOST["P-") S DR="12////"_DT,DIE="^ACM(41,",DA=ACMRGDFN D ^DIE
Q
ACMLCMS ; IHS/TUCSON/TMJ - ENTRY TO SET AND DISPLAY CLIENT DATA ; [ 01/03/06 2:03 PM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,5,6**;JAN 10, 1996
+2 ;PATCH #6 FIXES INSURANCE HEADER DISPLAY AND FORMAT PROBLEMS
+3 ;EP;ENTRY POINT TO SET AND DISPLAY CLIENT DATA
LCMS DO INIT
DO VARS
+1 QUIT
+2 ;
INIT ;S ACMDOB=$P(^DPT(ACMPTNO,0),U,3),(Y,X2)=ACMDOB,X1=DT
+1 ;IHS/CIM/THL PATCH 5
SET ACMDOB=$PIECE(^DPT(ACMPTNO,0),U,3)
SET (Y,X2)=ACMDOB
SET X1=DT
SET ACMPHONE=$PIECE($GET(^(.13)),U)
+2 DO ^%DTC
+3 XECUTE ^DD("DD")
+4 SET ACMDOB=Y
+5 IF X>365
SET ACMAGE=(X\365.25)_" YRS"
+6 IF (X>30)&(X<366)
SET ACMAGE=(X\30.4)_" MOS"
+7 IF X<31
SET ACMAGE=X_" (DYS)"
+8 QUIT
+9 ;
VARS IF $DATA(DUZ(2))#2
IF DUZ(2)
SET ACMSRT=$SELECT($DATA(^AUPNPAT(ACMPTNO,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"<NONE>")
+1 SET (ACMSTAT,ACMSEV,ACMPC,ACMINIT,ACMWHER,ACMCOMM,ACMPG)="NOT STATED"
SET (ACMPRV,ACMMGR,ACMPHN)="NONE ASSIGNED"
+2 SET ACMDT="^ACM(41,"_ACMRGDFN_",""DT"")"
+3 IF '$DATA(@ACMDT)
SET @ACMDT="A"
+4 SET ACMDT=@ACMDT
SET ACMSTAT=$SELECT($PIECE(ACMDT,U)'="":$PIECE(ACMDT,U),1:"NOT STATED")
SET ACMMGR=$SELECT($PIECE(ACMDT,U,6)'="":$PIECE(ACMDT,U,6),1:"NONE ASSIGNED")
+5 IF ACMMGR'="NONE ASSIGNED"
SET ACMMGR=$SELECT($DATA(^VA(200,ACMMGR,0)):$PIECE(^(0),U),1:"NONE ASSIGNED")
+6 SET ACMPHN=$SELECT($PIECE(ACMDT,U,7)'="":$PIECE(ACMDT,U,7),1:"NONE ASSIGNED")
+7 IF ACMPHN'="NONE ASSIGNED"
SET ACMPHN=$SELECT($DATA(^VA(200,ACMPHN,0)):$PIECE(^(0),U),1:"NONE ASSIGNED")
+8 SET ACMSEV=$SELECT($PIECE(ACMDT,U,5)'="":$PIECE(ACMDT,U,5),1:"NOT STATED")
+9 IF $PIECE(ACMDT,U,4)'=""
SET ACMINIT=$PIECE(ACMDT,U,4)
SET Y=ACMINIT
XECUTE ^DD("DD")
SET ACMINIT=Y
+10 SET ACMWHER=$SELECT($PIECE(ACMDT,U,10):$PIECE(ACMDT,U,10),1:"NOT STATED")
+11 IF ACMWHER'="NOT STATED"
SET ACMWHER=$SELECT($DATA(^AUTTLOC(ACMWHER,0)):$PIECE(^(0),U,2),1:"NOT STATED")
+12 SET ACMPG=$SELECT($PIECE(ACMDT,U,13)'="":$PIECE(ACMDT,U,13),1:"NOT STATED")
SET ACMPC=$SELECT($PIECE(ACMDT,U,14)'="":$PIECE(ACMDT,U,14),1:"NOT STATED")
SET ACMPRV=$SELECT($PIECE(ACMDT,U,15)'="":$PIECE(ACMDT,U,15),1:"NONE ASSIGNED")
+13 IF ACMPRV'="NONE ASSIGNED"
SET ACMPRV=$SELECT($DATA(^VA(200,ACMPRV,0)):$PIECE(^(0),U),1:"NONE ASSIGNED")
+14 SET ACMCOMM=$SELECT($DATA(^AUPNPAT(ACMPTNO,11)):$PIECE(^(11),U,18),1:"")
+15 IF ACMCOMM=""
SET ACMCOMM="NOT STATED"
+16 KILL ACMDT
+17 QUIT
ACMPT ;EP;TO DISPLAY PATIENT INFO
+1 IF '$DATA(ACMPAGE)
WRITE !?7,"CHART: ",ACMSRT
+2 ;IHS/ANMC/LJF 11/5/99 put PCP on separate line if rpt
IF $DATA(ACMPAGE)
WRITE !
+3 ;IHS/ANMC/LJF 11/5/99
WRITE ?35,"PRIMARY CARE PROVIDER: ",$$VAL^XBDIQ1(9000001,ACMPTNO,.14)
+4 WRITE !?9,"DOB: ",?14,ACMDOB,?53,"AGE: ",ACMAGE
+5 ;IHS/CIM/THL PATCH 5
WRITE !?5,"CONTACT: ",?14,$SELECT(ACMPG'="":ACMPG,1:"NOT LISTED"),?47,"COMMUNITY: ",ACMCOMM
+6 ;IHS/CIM/THL PATCH 5
WRITE !?46,"HOME PHONE: ",$GET(ACMPHONE)
+7 NEW APCHSPAT,APCHSCKP,APCHSNPG
+8 SET APCHSPAT=ACMPTNO
+9 SET APCHSCKP=""
+10 SET APCHSNPG=1
+11 SET APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
+12 ;IHS/CMI/TMJ PATCH #6
SET ACMINS=0
+13 IF $DATA(^AUPNMCD("B",ACMPTNO))
SET ACMINS=1
+14 IF $DATA(^AUPNMCR(ACMPTNO))
SET ACMINS=1
+15 IF $DATA(^AUPNPRVT(ACMPTNO))
SET ACMINS=1
+16 IF $DATA(^AUPNRRE(ACMPTNO))
SET ACMINS=1
+17 IF ACMINS=1
WRITE !,"************************** INSURANCE INFORMATION ***************************",!
+18 DO INS^APCHS5
+19 ;IHS/ANMC/LJF 11/5/99 separate editable from uneditable fields
WRITE !
+20 ;IHS/CMI/TMJ PATCH #6
WRITE " *********************** PATIENT INFORMATION *************************",!
+21 WRITE ?6,"STATUS: ",$SELECT(ACMSTAT="A":"ACTIVE",ACMSTAT="I":"INACTIVE",ACMSTAT="T":"TRANSIENT",ACMSTAT="U":"UNREVIEWED",ACMSTAT="D":"DECEASED",ACMSTAT="N":"NON-IHS",1:"NOT STATED")
+22 ;W ?44,"CASE PRIORIT: ",?14,$S(ACMSEV="L":"LOW",ACMSEV="M":"MEDIUM",ACMSEV="H":"HIGH",ACMSEV="C":"CRITICAL",1:"NOT STATED"),!,"PRIMARY PRVD: ",?14,ACMPRV
+23 ;IHS/ANMC/LJF 11/5/99
WRITE ?44,"CASE PRIORIT: ",?58,$SELECT(ACMSEV="L":"LOW",ACMSEV="M":"MEDIUM",ACMSEV="H":"HIGH",ACMSEV="C":"CRITICAL",1:"NOT STATED"),!,?6,"REGISTER PRV: ",?14,ACMPRV
+24 WRITE ?46,"INIT ENTRY: ",$SELECT($DATA(ACMINIT):ACMINIT,1:"NOT STATED"),!,?6,"CASE MANAGER: ",?14,ACMMGR,?46,"WHERE FLWD: ",ACMWHER
+25 WRITE !,?6,"PUB HLTH NRS:",?14,$SELECT($DATA(ACMPHN):ACMPHN,1:"NONE ASSIGNED")
+26 IF $DATA(ACMPAGE)&(IOST["P-")
SET DR="12////"_DT
SET DIE="^ACM(41,"
SET DA=ACMRGDFN
DO ^DIE
+27 QUIT
