ACMRL0 ;cmi/anch/maw - SCREEN LOGIC ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**10**;JUN 14, 2007;Build 12
;IHS/CMI/LAB - TMP TO XTMP
;
;
SELECT ;EP
S ACMANS=Y,ACMC="" F ACMI=1:1 S ACMC=$P(ACMANS,",",ACMI) Q:ACMC="" S ACMCRIT=ACMSEL(ACMC) D
.S ACMTEXT=$P(^ACM(58.1,ACMCRIT,0),U)
.S ACMVAR=$P(^ACM(58.1,ACMCRIT,0),U,6) K ^ACM(58.8,ACMRPT,11,ACMCRIT),^ACM(58.8,ACMRPT,11,"B",ACMCRIT)
.W !!,ACMC,") ",ACMTEXT," Selection."
.I $P(^ACM(58.1,ACMCRIT,0),U,2)]"" S ACMCNT=0,^ACM(58.8,ACMRPT,11,0)="^9002258.81101PA^0^0" D @$P(^ACM(58.1,ACMCRIT,0),U,2)
.Q
Q
PSELECT ;EP
S ACMANS=Y,ACMC="" F ACMI=1:1 S ACMC=$P(ACMANS,",",ACMI) Q:ACMC="" S ACMCRIT=ACMSEL(ACMC),ACMPCNT=ACMPCNT+1 D
.I ACMCTYP="F" S Y=0 G SET
.S DIR(0)="N^2:80:0",DIR("A")="Enter Column width for "_$P(^ACM(58.1,ACMCRIT,0),U)_" (suggested: "_$P(^ACM(58.1,ACMCRIT,0),U,7)_")",DIR("B")=$P(^(0),U,7) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
.I $D(DIRUT) S Y=$P(^ACM(58.1,ACMCRIT,0),U,7)
SET .S ^ACM(58.8,ACMRPT,12,0)="^9002258.81102PA^1^1" ;IHS/CMI/LAB
.I $D(^ACM(58.8,ACMRPT,12,"B",ACMCRIT)) S X=$O(^ACM(58.8,ACMRPT,12,"B",ACMCRIT,"")),ACMTCW=ACMTCW-$P(^ACM(58.8,ACMRPT,12,X,0),U,2)-2,^ACM(58.8,ACMRPT,12,X,0)=ACMCRIT_U_Y D Q
..Q
.S ^ACM(58.8,ACMRPT,12,ACMPCNT,0)=ACMCRIT_U_Y,^ACM(58.8,ACMRPT,12,"B",ACMCRIT,ACMPCNT)="",ACMTCW=ACMTCW+Y+2
.I ACMCTYP="P" W !!?15,"Total Report width (including column margins - 2 spaces): ",ACMTCW ;IHS/CMI/LAB
.Q
Q
I ;DIC CALL WITH SCREEN
K DIC,DA,DR
S DIC=$P(^ACM(58.1,ACMCRIT,0),U,13) I DIC="" W !!,"ERROR IN CONTROL TABLE." H 4 Q
S DIC(0)="AEMQ",DIC("A")="ENTER "_$P(^ACM(58.1,ACMCRIT,0),U)_": "
S ACMDIC2="^ACM("_$E(DIC,6,99)_")"
S DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
D ^DIC K DIC,DA,DR
I Y=-1 Q
S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$P(Y,U),^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$P(Y,U),ACMCNT)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
G I
Q
Q ;EP
K ^XTMP("ACMRL",$J,"QMAN"),^UTILITY("AMQQ TAX",$J)
K DIC,X,Y,DD S X=$P(^ACM(58.1,ACMCRIT,0),U,3),DIC="^AMQQ(5,",DIC(0)="EQXM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA,DINUM,DICR I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
S ACMQMAN=+Y
D ^AMQQGTX0(ACMQMAN,"^XTMP(""ACMRL"",$J,""QMAN"",")
I '$D(^XTMP("ACMRL",$J,"QMAN")) W !!,$C(7),"** No ",$P(^ACM(58.1,ACMCRIT,0),U)," selected, all will be included." Q
I $D(^XTMP("ACMRL",$J,"QMAN","*")) K ^XTMP("ACMRL",$J,"QMAN")
S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
S X="",Y=0 F S X=$O(^XTMP("ACMRL",$J,"QMAN",X)) Q:X="" S Y=Y+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,Y,0)=X,^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",X,Y)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_Y_"^"_Y
K X,Y,Z,ACMQMAN,V
K ^XTMP("ACMRL",$J,"QMAN")
Q
R ;EP
S DIR(0)=$P(^ACM(58.1,ACMCRIT,0),U,4)_"O",DIR("A")="ENTER "_$P(^(0),U) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
I Y="" Q
S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$P(Y,U),^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$P(Y,U),ACMCNT)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
G R
Q
D ;EP;DATE RANGE
BD ;get beginning date
;cmi/anch/maw 9/6/2007 patch 7 begin mods
;W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_ACMTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K %DT W ! S %DT="AE",%DT("A")="Enter beginning "_ACMTEXT_" for Search: " D ^%DT
;I $D(DIRUT) Q
Q:'Y
S ACMBD=Y
;cmi/anch/maw 9/6/2007 patch 7 end mods
ED ;get ending date IHS/CMI/TMJ PATCH #6 date display
;cmi/maw patch 7 10/1/2006 changed date display back to the way it was at the date
;shown in parens is a fileman thing that cannot be controlled. and the patch 6 date
;control did not work
;cmi/anch/maw 9/6/2007 patch 7 begin mods
;W ! S DIR(0)="D^"_ACMBD_"::EX",DIR("A")="Enter ending "_ACMTEXT_" for Search" S Y=ACMBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K %DT W ! S %DT="AE",%DT(0)=ACMBD,%DT("A")="Enter ending "_ACMTEXT_" for Search: ",%DT("B")=$$FMTE^XLFDT(ACMBD) D ^%DT
;I $D(DIRUT) G BD
G BD:'Y
;cmi/anch/maw 9/6/2007 end of mods
S ACMED=Y
S X1=ACMBD,X2=-1 D C^%DTC S ACMSD=X
;
S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
S ACMCNT=0,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)="^9002258.8110101A^1^1" S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0)=ACMBD_U_ACMED,^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",ACMBD,ACMCNT)=""
Q
N ;
D N^ACMRL01
Q
F ;FREE TEXT RANGE
D F^ACMRL01
Q
J ;
D J^ACMRL01
Q
Y ;
D Y^ACMRL01
Q
W ;EP - contains
K DIR,DTOUT,DUOUT,DIRUT
W !!,?5,"What phrase do you want to search for in the ",$P(^ACM(58.1,ACMCRIT,0),U),"?",!
S DIR(0)="FO^2:40",DIR("A")=$P(^ACM(58.1,ACMCRIT,0),U)_" - CONTAIN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT,^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
S ACMCNT=ACMCNT+1,^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$P(Y,U),^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$P(Y,U),ACMCNT)="",^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
G W
;
Q
ACMRL0 ;cmi/anch/maw - SCREEN LOGIC ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**10**;JUN 14, 2007;Build 12
+2 ;IHS/CMI/LAB - TMP TO XTMP
+3 ;
+4 ;
SELECT ;EP
+1 SET ACMANS=Y
SET ACMC=""
FOR ACMI=1:1
SET ACMC=$PIECE(ACMANS,",",ACMI)
IF ACMC=""
QUIT
SET ACMCRIT=ACMSEL(ACMC)
Begin DoDot:1
+2 SET ACMTEXT=$PIECE(^ACM(58.1,ACMCRIT,0),U)
+3 SET ACMVAR=$PIECE(^ACM(58.1,ACMCRIT,0),U,6)
KILL ^ACM(58.8,ACMRPT,11,ACMCRIT),^ACM(58.8,ACMRPT,11,"B",ACMCRIT)
+4 WRITE !!,ACMC,") ",ACMTEXT," Selection."
+5 IF $PIECE(^ACM(58.1,ACMCRIT,0),U,2)]""
SET ACMCNT=0
SET ^ACM(58.8,ACMRPT,11,0)="^9002258.81101PA^0^0"
DO @$PIECE(^ACM(58.1,ACMCRIT,0),U,2)
+6 QUIT
End DoDot:1
+7 QUIT
PSELECT ;EP
+1 SET ACMANS=Y
SET ACMC=""
FOR ACMI=1:1
SET ACMC=$PIECE(ACMANS,",",ACMI)
IF ACMC=""
QUIT
SET ACMCRIT=ACMSEL(ACMC)
SET ACMPCNT=ACMPCNT+1
Begin DoDot:1
+2 IF ACMCTYP="F"
SET Y=0
GOTO SET
+3 SET DIR(0)="N^2:80:0"
SET DIR("A")="Enter Column width for "_$PIECE(^ACM(58.1,ACMCRIT,0),U)_" (suggested: "_$PIECE(^ACM(58.1,ACMCRIT,0),U,7)_")"
SET DIR("B")=$PIECE(^(0),U,7)
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
SET Y=$PIECE(^ACM(58.1,ACMCRIT,0),U,7)
SET ;IHS/CMI/LAB
SET ^ACM(58.8,ACMRPT,12,0)="^9002258.81102PA^1^1"
+1 IF $DATA(^ACM(58.8,ACMRPT,12,"B",ACMCRIT))
SET X=$ORDER(^ACM(58.8,ACMRPT,12,"B",ACMCRIT,""))
SET ACMTCW=ACMTCW-$PIECE(^ACM(58.8,ACMRPT,12,X,0),U,2)-2
SET ^ACM(58.8,ACMRPT,12,X,0)=ACMCRIT_U_Y
Begin DoDot:2
+2 QUIT
End DoDot:2
QUIT
+3 SET ^ACM(58.8,ACMRPT,12,ACMPCNT,0)=ACMCRIT_U_Y
SET ^ACM(58.8,ACMRPT,12,"B",ACMCRIT,ACMPCNT)=""
SET ACMTCW=ACMTCW+Y+2
+4 ;IHS/CMI/LAB
IF ACMCTYP="P"
WRITE !!?15,"Total Report width (including column margins - 2 spaces): ",ACMTCW
+5 QUIT
End DoDot:1
+6 QUIT
I ;DIC CALL WITH SCREEN
+1 KILL DIC,DA,DR
+2 SET DIC=$PIECE(^ACM(58.1,ACMCRIT,0),U,13)
IF DIC=""
WRITE !!,"ERROR IN CONTROL TABLE."
HANG 4
QUIT
+3 SET DIC(0)="AEMQ"
SET DIC("A")="ENTER "_$PIECE(^ACM(58.1,ACMCRIT,0),U)_": "
+4 SET ACMDIC2="^ACM("_$EXTRACT(DIC,6,99)_")"
+5 SET DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
+6 DO ^DIC
KILL DIC,DA,DR
+7 IF Y=-1
QUIT
+8 SET ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT
SET ^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
+9 SET ACMCNT=ACMCNT+1
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$PIECE(Y,U)
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$PIECE(Y,U),ACMCNT)=""
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
+10 GOTO I
+11 QUIT
Q ;EP
+1 KILL ^XTMP("ACMRL",$JOB,"QMAN"),^UTILITY("AMQQ TAX",$JOB)
+2 KILL DIC,X,Y,DD
SET X=$PIECE(^ACM(58.1,ACMCRIT,0),U,3)
SET DIC="^AMQQ(5,"
SET DIC(0)="EQXM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA,DINUM,DICR
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
QUIT
+3 SET ACMQMAN=+Y
+4 DO ^AMQQGTX0(ACMQMAN,"^XTMP(""ACMRL"",$J,""QMAN"",")
+5 IF '$DATA(^XTMP("ACMRL",$JOB,"QMAN"))
WRITE !!,$CHAR(7),"** No ",$PIECE(^ACM(58.1,ACMCRIT,0),U)," selected, all will be included."
QUIT
+6 IF $DATA(^XTMP("ACMRL",$JOB,"QMAN","*"))
KILL ^XTMP("ACMRL",$JOB,"QMAN")
+7 SET ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT
SET ^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
+8 SET X=""
SET Y=0
FOR
SET X=$ORDER(^XTMP("ACMRL",$JOB,"QMAN",X))
IF X=""
QUIT
SET Y=Y+1
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,Y,0)=X
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",X,Y)=""
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_Y_"^"_Y
+9 KILL X,Y,Z,ACMQMAN,V
+10 KILL ^XTMP("ACMRL",$JOB,"QMAN")
+11 QUIT
R ;EP
+1 SET DIR(0)=$PIECE(^ACM(58.1,ACMCRIT,0),U,4)_"O"
SET DIR("A")="ENTER "_$PIECE(^(0),U)
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 SET ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT
SET ^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
+5 SET ACMCNT=ACMCNT+1
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$PIECE(Y,U)
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$PIECE(Y,U),ACMCNT)=""
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
+6 GOTO R
+7 QUIT
D ;EP;DATE RANGE
BD ;get beginning date
+1 ;cmi/anch/maw 9/6/2007 patch 7 begin mods
+2 ;W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_ACMTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
+3 KILL %DT
WRITE !
SET %DT="AE"
SET %DT("A")="Enter beginning "_ACMTEXT_" for Search: "
DO ^%DT
+4 ;I $D(DIRUT) Q
+5 IF 'Y
QUIT
+6 SET ACMBD=Y
+7 ;cmi/anch/maw 9/6/2007 patch 7 end mods
ED ;get ending date IHS/CMI/TMJ PATCH #6 date display
+1 ;cmi/maw patch 7 10/1/2006 changed date display back to the way it was at the date
+2 ;shown in parens is a fileman thing that cannot be controlled. and the patch 6 date
+3 ;control did not work
+4 ;cmi/anch/maw 9/6/2007 patch 7 begin mods
+5 ;W ! S DIR(0)="D^"_ACMBD_"::EX",DIR("A")="Enter ending "_ACMTEXT_" for Search" S Y=ACMBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
+6 KILL %DT
WRITE !
SET %DT="AE"
SET %DT(0)=ACMBD
SET %DT("A")="Enter ending "_ACMTEXT_" for Search: "
SET %DT("B")=$$FMTE^XLFDT(ACMBD)
DO ^%DT
+7 ;I $D(DIRUT) G BD
+8 IF 'Y
GOTO BD
+9 ;cmi/anch/maw 9/6/2007 end of mods
+10 SET ACMED=Y
+11 SET X1=ACMBD
SET X2=-1
DO C^%DTC
SET ACMSD=X
+12 ;
+13 SET ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT
SET ^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
+14 SET ACMCNT=0
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)="^9002258.8110101A^1^1"
SET ACMCNT=ACMCNT+1
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,1,0)=ACMBD_U_ACMED
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",ACMBD,ACMCNT)=""
+15 QUIT
N ;
+1 DO N^ACMRL01
+2 QUIT
F ;FREE TEXT RANGE
+1 DO F^ACMRL01
+2 QUIT
J ;
+1 DO J^ACMRL01
+2 QUIT
Y ;
+1 DO Y^ACMRL01
+2 QUIT
W ;EP - contains
+1 KILL DIR,DTOUT,DUOUT,DIRUT
+2 WRITE !!,?5,"What phrase do you want to search for in the ",$PIECE(^ACM(58.1,ACMCRIT,0),U),"?",!
+3 SET DIR(0)="FO^2:40"
SET DIR("A")=$PIECE(^ACM(58.1,ACMCRIT,0),U)_" - CONTAIN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=""
QUIT
+6 SET ^ACM(58.8,ACMRPT,11,ACMCRIT,0)=ACMCRIT
SET ^ACM(58.8,ACMRPT,11,"B",ACMCRIT,ACMCRIT)=""
+7 SET ACMCNT=ACMCNT+1
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,ACMCNT,0)=$PIECE(Y,U)
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,"B",$PIECE(Y,U),ACMCNT)=""
SET ^ACM(58.8,ACMRPT,11,ACMCRIT,11,0)="^9002258.8110101A^"_ACMCNT_"^"_ACMCNT
+8 GOTO W
+9 ;
+10 QUIT
