- GMPLSLI2 ;ISP/TC - Problem Selection List Import Utility ;07/18/17 09:43
- ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
- ;
- ; External References:
- ; ICR 10142 EN^DDIOL
- ;
- ISCSV(GMPLLINE) ;Verify that LINE is in CSV format with at least 3 pieces of data
- I $L(GMPLLINE)=0 Q 0
- N GMPLCSV
- S GMPLCSV=$S($L(GMPLLINE,",")>2:1,1:0)
- I 'GMPLCSV D
- . N GMPLTXT
- . S GMPLTXT(1)=""
- . S GMPLTXT(2)="The following line is not in CSV format and cannot be processed:"
- . S GMPLTXT(3)=" "_GMPLLINE
- . D EN^DDIOL(.GMPLTXT)
- . H 1
- Q GMPLCSV
- ;============================================
- RBLCKHF(GMPLNIN,GMPLNOUT) ;FTG^%ZISH breaks lines at 255 characters. This could
- ;put a mapping across two lines. Format the ^TMP array so this does not
- ;happen.
- N GMPLCHAR,GMPLI,GMPLJ,GMPLK,GMPLL1,GMPLNL1,GMPLNL2,GMPLTMP
- K ^TMP($J,"GMPLNOUT")
- S GMPLI="",GMPLNL1=0
- F S GMPLI=+$O(^TMP($J,GMPLNIN,GMPLI)) Q:GMPLI=0 D
- . S GMPLTMP=^TMP($J,GMPLNIN,GMPLI),GMPLNL1=GMPLNL1+1
- . I '$D(^TMP($J,GMPLNIN,GMPLI,"OVF")) S ^TMP($J,GMPLNOUT,GMPLNL1,1)=GMPLTMP Q
- . S GMPLL1="",GMPLNL2=0
- . F GMPLJ=1:1:$L(GMPLTMP) D
- .. S GMPLCHAR=$E(GMPLTMP,GMPLJ)
- .. S GMPLL1=GMPLL1_GMPLCHAR
- .. I $L(GMPLL1)>230,GMPLCHAR="," S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1,GMPLL1=""
- .;Check for overflow nodes.
- . S GMPLJ=0
- . F S GMPLJ=+$O(^TMP($J,GMPLNIN,GMPLI,"OVF",GMPLJ)) Q:GMPLJ=0 D
- .. S GMPLTMP=^TMP($J,GMPLNIN,GMPLI,"OVF",GMPLJ)
- .. F GMPLK=1:1:$L(GMPLTMP) D
- ... S GMPLCHAR=$E(GMPLTMP,GMPLK)
- ... S GMPLL1=GMPLL1_GMPLCHAR
- ... I $L(GMPLL1)>230,GMPLCHAR="," S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1,GMPLL1=""
- . I $L(GMPLL1)>0 S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- Q
- ;============================================
- RBLCKWEB(GMPLNIN,GMPLNOUT) ;GETURL^XTHC10 breaks lines at 245 characters. This
- ;could break a line into two lines. Format the ^TMP array so this does
- ;not happen.
- N GMPLCHAR,GMPLI,GMPLJ,GMPLK,GMPLL1,GMPLLEN,GMPLNL1,GMPLNL2,GMPLTMP
- K ^TMP($J,"GMPLNOUT")
- S GMPLI="",GMPLNL1=0
- F S GMPLI=+$O(^TMP($J,GMPLNIN,GMPLI)) Q:GMPLI=0 D
- . S GMPLTMP=^TMP($J,GMPLNIN,GMPLI),GMPLLEN=$L(GMPLTMP)
- . I GMPLLEN=0 S GMPLNL1=GMPLNL1+1,^TMP($J,GMPLNOUT,GMPLNL1,1)=GMPLTMP Q
- . S GMPLNL1=GMPLNL1+1
- . I $D(^TMP($J,GMPLNIN,GMPLI))<11 S ^TMP($J,GMPLNOUT,GMPLNL1,1)=$TR(GMPLTMP,$C(13),"") Q
- . S GMPLL1="",GMPLNL2=0
- . F GMPLJ=1:1:$L(GMPLTMP) D
- .. S GMPLCHAR=$E(GMPLTMP,GMPLJ)
- .. I GMPLCHAR=$C(13) Q
- .. S GMPLL1=GMPLL1_GMPLCHAR
- .. I $L(GMPLL1)>230,GMPLCHAR="," S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1,GMPLL1=""
- .;Check for overflow nodes.
- . S GMPLJ=0
- . F S GMPLJ=+$O(^TMP($J,GMPLNIN,GMPLI,GMPLJ)) Q:GMPLJ=0 D
- .. S GMPLTMP=^TMP($J,GMPLNIN,GMPLI,GMPLJ)
- .. F GMPLK=1:1:$L(GMPLTMP) D
- ... S GMPLCHAR=$E(GMPLTMP,GMPLK)
- ... I GMPLCHAR=$C(13) Q
- ... S GMPLL1=GMPLL1_GMPLCHAR
- ... I $L(GMPLL1)>230,GMPLCHAR="," S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1,GMPLL1=""
- . I $L(GMPLL1)>0 S GMPLNL2=GMPLNL2+1,^TMP($J,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLSLI2 3088 printed Mar 13, 2025@21:35:13 Page 2
- GMPLSLI2 ;ISP/TC - Problem Selection List Import Utility ;07/18/17 09:43
- +1 ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
- +2 ;
- +3 ; External References:
- +4 ; ICR 10142 EN^DDIOL
- +5 ;
- ISCSV(GMPLLINE) ;Verify that LINE is in CSV format with at least 3 pieces of data
- +1 IF $LENGTH(GMPLLINE)=0
- QUIT 0
- +2 NEW GMPLCSV
- +3 SET GMPLCSV=$SELECT($LENGTH(GMPLLINE,",")>2:1,1:0)
- +4 IF 'GMPLCSV
- Begin DoDot:1
- +5 NEW GMPLTXT
- +6 SET GMPLTXT(1)=""
- +7 SET GMPLTXT(2)="The following line is not in CSV format and cannot be processed:"
- +8 SET GMPLTXT(3)=" "_GMPLLINE
- +9 DO EN^DDIOL(.GMPLTXT)
- +10 HANG 1
- End DoDot:1
- +11 QUIT GMPLCSV
- +12 ;============================================
- RBLCKHF(GMPLNIN,GMPLNOUT) ;FTG^%ZISH breaks lines at 255 characters. This could
- +1 ;put a mapping across two lines. Format the ^TMP array so this does not
- +2 ;happen.
- +3 NEW GMPLCHAR,GMPLI,GMPLJ,GMPLK,GMPLL1,GMPLNL1,GMPLNL2,GMPLTMP
- +4 KILL ^TMP($JOB,"GMPLNOUT")
- +5 SET GMPLI=""
- SET GMPLNL1=0
- +6 FOR
- SET GMPLI=+$ORDER(^TMP($JOB,GMPLNIN,GMPLI))
- if GMPLI=0
- QUIT
- Begin DoDot:1
- +7 SET GMPLTMP=^TMP($JOB,GMPLNIN,GMPLI)
- SET GMPLNL1=GMPLNL1+1
- +8 IF '$DATA(^TMP($JOB,GMPLNIN,GMPLI,"OVF"))
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,1)=GMPLTMP
- QUIT
- +9 SET GMPLL1=""
- SET GMPLNL2=0
- +10 FOR GMPLJ=1:1:$LENGTH(GMPLTMP)
- Begin DoDot:2
- +11 SET GMPLCHAR=$EXTRACT(GMPLTMP,GMPLJ)
- +12 SET GMPLL1=GMPLL1_GMPLCHAR
- +13 IF $LENGTH(GMPLL1)>230
- IF GMPLCHAR=","
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- SET GMPLL1=""
- End DoDot:2
- +14 ;Check for overflow nodes.
- +15 SET GMPLJ=0
- +16 FOR
- SET GMPLJ=+$ORDER(^TMP($JOB,GMPLNIN,GMPLI,"OVF",GMPLJ))
- if GMPLJ=0
- QUIT
- Begin DoDot:2
- +17 SET GMPLTMP=^TMP($JOB,GMPLNIN,GMPLI,"OVF",GMPLJ)
- +18 FOR GMPLK=1:1:$LENGTH(GMPLTMP)
- Begin DoDot:3
- +19 SET GMPLCHAR=$EXTRACT(GMPLTMP,GMPLK)
- +20 SET GMPLL1=GMPLL1_GMPLCHAR
- +21 IF $LENGTH(GMPLL1)>230
- IF GMPLCHAR=","
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- SET GMPLL1=""
- End DoDot:3
- End DoDot:2
- +22 IF $LENGTH(GMPLL1)>0
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- End DoDot:1
- +23 QUIT
- +24 ;============================================
- RBLCKWEB(GMPLNIN,GMPLNOUT) ;GETURL^XTHC10 breaks lines at 245 characters. This
- +1 ;could break a line into two lines. Format the ^TMP array so this does
- +2 ;not happen.
- +3 NEW GMPLCHAR,GMPLI,GMPLJ,GMPLK,GMPLL1,GMPLLEN,GMPLNL1,GMPLNL2,GMPLTMP
- +4 KILL ^TMP($JOB,"GMPLNOUT")
- +5 SET GMPLI=""
- SET GMPLNL1=0
- +6 FOR
- SET GMPLI=+$ORDER(^TMP($JOB,GMPLNIN,GMPLI))
- if GMPLI=0
- QUIT
- Begin DoDot:1
- +7 SET GMPLTMP=^TMP($JOB,GMPLNIN,GMPLI)
- SET GMPLLEN=$LENGTH(GMPLTMP)
- +8 IF GMPLLEN=0
- SET GMPLNL1=GMPLNL1+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,1)=GMPLTMP
- QUIT
- +9 SET GMPLNL1=GMPLNL1+1
- +10 IF $DATA(^TMP($JOB,GMPLNIN,GMPLI))<11
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,1)=$TRANSLATE(GMPLTMP,$CHAR(13),"")
- QUIT
- +11 SET GMPLL1=""
- SET GMPLNL2=0
- +12 FOR GMPLJ=1:1:$LENGTH(GMPLTMP)
- Begin DoDot:2
- +13 SET GMPLCHAR=$EXTRACT(GMPLTMP,GMPLJ)
- +14 IF GMPLCHAR=$CHAR(13)
- QUIT
- +15 SET GMPLL1=GMPLL1_GMPLCHAR
- +16 IF $LENGTH(GMPLL1)>230
- IF GMPLCHAR=","
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- SET GMPLL1=""
- End DoDot:2
- +17 ;Check for overflow nodes.
- +18 SET GMPLJ=0
- +19 FOR
- SET GMPLJ=+$ORDER(^TMP($JOB,GMPLNIN,GMPLI,GMPLJ))
- if GMPLJ=0
- QUIT
- Begin DoDot:2
- +20 SET GMPLTMP=^TMP($JOB,GMPLNIN,GMPLI,GMPLJ)
- +21 FOR GMPLK=1:1:$LENGTH(GMPLTMP)
- Begin DoDot:3
- +22 SET GMPLCHAR=$EXTRACT(GMPLTMP,GMPLK)
- +23 IF GMPLCHAR=$CHAR(13)
- QUIT
- +24 SET GMPLL1=GMPLL1_GMPLCHAR
- +25 IF $LENGTH(GMPLL1)>230
- IF GMPLCHAR=","
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- SET GMPLL1=""
- End DoDot:3
- End DoDot:2
- +26 IF $LENGTH(GMPLL1)>0
- SET GMPLNL2=GMPLNL2+1
- SET ^TMP($JOB,GMPLNOUT,GMPLNL1,GMPLNL2)=GMPLL1
- End DoDot:1
- +27 QUIT
