PXRMLLED ; SLC/PJH - Edit a location list. ;06/09/2009
;;2.0;CLINICAL REMINDERS;**4,6,11,12**;Feb 04, 2005;Build 73
;
;================================================================
N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
GETNAME ;Get the name of the location list to edit.
K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
S DIC="^PXRMD(810.9,"
S DIC(0)="AEMQL"
S DIC("A")="Select Location List: "
S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
S DLAYGO=810.9
;Set the starting place for additions.
D SETSTART^PXRMCOPY(DIC)
W !
D ^DIC
I ($D(DTOUT))!($D(DUOUT)) Q
I Y=-1 G END
S DA=$P(Y,U,1)
S CS1=$$FILE^PXRMEXCS(810.9,DA)
D EDIT(DIC,DA)
;See if any changes have been made, if so do the edit history.
S CS2=$$FILE^PXRMEXCS(810.9,DA)
I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(810.9,DIC,DA)
G GETNAME
END ;
Q
;
;================================================================
EDIT(ROOT,DA) ;
N DIE,DR,DIDEL,RESULT,X,Y
S DIE=ROOT,DIDEL=810.9
NAME S DR=".01"
D ^DIE
I '$D(DA) Q
I $D(Y) Q
CLASS ;
;Class
RETRY W !!
S DR="100"
D ^DIE
I $D(Y) G NAME
;Sponsor
S DR="101"
D ^DIE
I $D(Y) G RETRY
;Make sure Class and Sponsor Class are in synch.
S RESULT=$$VSPONSOR^PXRMINTR(X)
I RESULT=0 S DIE("NO^")="Other value" G RETRY
I RESULT=1 K DIE("NO^")
;Review date
RD W !!
S DR="102"
D ^DIE
I $D(Y) G RETRY
;
;Description
DES S DR="1"
D ^DIE
I $D(Y) G RD
;
;Clinic Stops
CS S DR="40.7"
S DR(2,810.9001)=".01;1;2;3"
S DR(3,810.90011)=".01"
D ^DIE
I $D(Y) G RD
;
;Hospital Locations
HL S DR="44"
D ^DIE
I $D(Y) G CS
Q
;
;================================================================
KAMIS(X,DA,WHICH) ;Kill the AMIS Reporting Stop Code.
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q
I WHICH="CREDIT STOP TO EXCLUDE" S $P(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=""
E S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
Q
;
;================================================================
SAMIS(X,DA,WHICH) ;Set the AMIS Reporting Stop Code.
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q
N AMIS
;DBIA #557
S AMIS=$P(^DIC(40.7,X,0),U,2)
I WHICH="CREDIT STOP TO EXCLUDE" S $P(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=AMIS
E S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLLED 2484 printed Apr 09, 2024@20:53:45 Page 2
PXRMLLED ; SLC/PJH - Edit a location list. ;06/09/2009
+1 ;;2.0;CLINICAL REMINDERS;**4,6,11,12**;Feb 04, 2005;Build 73
+2 ;
+3 ;================================================================
+4 NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
GETNAME ;Get the name of the location list to edit.
+1 KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y
+2 SET DIC="^PXRMD(810.9,"
+3 SET DIC(0)="AEMQL"
+4 SET DIC("A")="Select Location List: "
+5 SET DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
+6 SET DLAYGO=810.9
+7 ;Set the starting place for additions.
+8 DO SETSTART^PXRMCOPY(DIC)
+9 WRITE !
+10 DO ^DIC
+11 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+12 IF Y=-1
GOTO END
+13 SET DA=$PIECE(Y,U,1)
+14 SET CS1=$$FILE^PXRMEXCS(810.9,DA)
+15 DO EDIT(DIC,DA)
+16 ;See if any changes have been made, if so do the edit history.
+17 SET CS2=$$FILE^PXRMEXCS(810.9,DA)
+18 IF CS2'=0
IF CS2'=CS1
DO SEHIST^PXRMUTIL(810.9,DIC,DA)
+19 GOTO GETNAME
END ;
+1 QUIT
+2 ;
+3 ;================================================================
EDIT(ROOT,DA) ;
+1 NEW DIE,DR,DIDEL,RESULT,X,Y
+2 SET DIE=ROOT
SET DIDEL=810.9
NAME SET DR=".01"
+1 DO ^DIE
+2 IF '$DATA(DA)
QUIT
+3 IF $DATA(Y)
QUIT
CLASS ;
+1 ;Class
RETRY WRITE !!
+1 SET DR="100"
+2 DO ^DIE
+3 IF $DATA(Y)
GOTO NAME
+4 ;Sponsor
+5 SET DR="101"
+6 DO ^DIE
+7 IF $DATA(Y)
GOTO RETRY
+8 ;Make sure Class and Sponsor Class are in synch.
+9 SET RESULT=$$VSPONSOR^PXRMINTR(X)
+10 IF RESULT=0
SET DIE("NO^")="Other value"
GOTO RETRY
+11 IF RESULT=1
KILL DIE("NO^")
+12 ;Review date
RD WRITE !!
+1 SET DR="102"
+2 DO ^DIE
+3 IF $DATA(Y)
GOTO RETRY
+4 ;
+5 ;Description
DES SET DR="1"
+1 DO ^DIE
+2 IF $DATA(Y)
GOTO RD
+3 ;
+4 ;Clinic Stops
CS SET DR="40.7"
+1 SET DR(2,810.9001)=".01;1;2;3"
+2 SET DR(3,810.90011)=".01"
+3 DO ^DIE
+4 IF $DATA(Y)
GOTO RD
+5 ;
+6 ;Hospital Locations
HL SET DR="44"
+1 DO ^DIE
+2 IF $DATA(Y)
GOTO CS
+3 QUIT
+4 ;
+5 ;================================================================
KAMIS(X,DA,WHICH) ;Kill the AMIS Reporting Stop Code.
+1 ;Do not execute as part of a verify fields.
+2 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+3 ;Do not execute as part of exchange.
+4 IF $GET(PXRMEXCH)
QUIT
+5 IF WHICH="CREDIT STOP TO EXCLUDE"
SET $PIECE(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=""
+6 IF '$TEST
SET $PIECE(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
+7 QUIT
+8 ;
+9 ;================================================================
SAMIS(X,DA,WHICH) ;Set the AMIS Reporting Stop Code.
+1 ;Do not execute as part of a verify fields.
+2 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+3 ;Do not execute as part of exchange.
+4 IF $GET(PXRMEXCH)
QUIT
+5 NEW AMIS
+6 ;DBIA #557
+7 SET AMIS=$PIECE(^DIC(40.7,X,0),U,2)
+8 IF WHICH="CREDIT STOP TO EXCLUDE"
SET $PIECE(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=AMIS
+9 IF '$TEST
SET $PIECE(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
+10 QUIT
+11 ;
